VBScript保存インターネットからのPDF

Question

ハイパーリンクを含むExcelファイルを開くスクリプトを作成しました。 VbscriptはInternet Explorerでハイパーリンクを開き、デフォルトのprinter.pdfとしてpdfとしてページを保存します。これはループしています。 私の問題は、スクリプトが毎回異なるステップで失敗することです。私はこのスクリプトをどのように書き直して安定したものにすることができるのか分かりません。

Dim WshShell 
Dim Lastrow 
Dim objFso 


'#### Cleanup any left-over Excel processes ####' 
Dim objProcess, colProcess, strComputer, objWMIService 
Dim strProcessKill 
strComputer = "." 
strProcessKill = "'excel.exe'" 

Set objWMIService = GetObject("winmgmts:" _ 
& "{impersonationLevel=impersonate}!\\" _ 
& strComputer & "\root\cimv2") 

Set colProcess = objWMIService.ExecQuery _ 
("Select * from Win32_Process Where Name = " & strProcessKill) 
For Each objProcess in colProcess 
objProcess.Terminate() 
Next 
'#### End of Cleanup any left-over Excel processes ####' 


'Open excel file and start macro code 
Dim ws_path 
ws_path= Replace(WScript.ScriptFullName, WScript.ScriptName, "") 
Set ExcelObject = Createobject("Excel.application") 
ExcelObject.visible = True 
ExcelObject.workbooks.open(ws_path & "Template.xlsm") 
ExcelObject.run ("FilePreparation") 



Set WshShell = WScript.CreateObject("WScript.Shell") 
Set objFso = WScript.CreateObject("Scripting.FileSystemObject") 

'Actual date for the save folder 
Function TwoDigits(strParam) 
    If Len(strParam) = 1 Then 
     TwoDigits = "0" & strParam 
     Else 
     TwoDigits = strParam 
    End if 
End Function 

dtmActualTime = Date 
strActualTime = TwoDigits(Day(dtmActualTime)) & TwoDigits(Month(dtmActualTime)) & Year(dtmActualTime) 
strpath = Replace(WScript.ScriptFullName, WScript.ScriptName, "") 
folderpath= strpath & "Outputs\" 
If Not objFso.FolderExists(folderpath & strActualTime & "\") Then 
    objFso.CreateFolder (folderpath & strActualTime & "\") 
End If 
savepath= folderpath & strActualTime & "\" 


Lastrow = ExcelObject.ActiveWorkbook.Sheets("Links").Cells(ExcelObject.ActiveWorkbook.Sheets("Links").Rows.Count, "I").End("-4162").Row 

'Loop through the links in the excel file 
prntname = "PDFCreator" 
num = 2 

do while (num <= Lastrow) 
    On Error Resume next   
     ExcelObject.Activeworkbook.Sheets("Links").Cells(1, 9).Value = ExcelObject.Activeworkbook.Sheets("Links").Cells(num, 10).Value 
     pdfname = ExcelObject.Activeworkbook.Sheets("Links").Cells(1, 9).Value 
     urlname= ExcelObject.Activeworkbook.Sheets("Links").Cells(num, 9).Value 

      'Check if this set of file has already run, if so then quit from script 
      Set objFolder = objFso.GetFolder(savepath) 
      Set objFiles = objFolder.Files 
       For i=0 to objFiles.Count 
        If objFso.FileExists(savepath & pdfname & ".pdf") Then 
         'WScript.echo "Already run this file!" 
         ExcelObject.DisplayAlerts = False 
         ExcelObject.Quit 
         WScript.Quit 
        End If 
       Next 

      'Default printer is PDFCreator 
      Dim objPrinter 
      Set objPrinter = CreateObject("WScript.Network") 
      objPrinter.SetDefaultPrinter prntname 

      'Open URL 
      Set IE = CreateObject("InternetExplorer.Application") 
      IE.Visible = True 
      IE.Navigate urlname 
      WScript.Sleep 5000 
      While IE.Busy 
       WScript.Sleep 1000 
      Wend 

      'Activate IExplorer and Print window pop up 
      Set Processes = GetObject("winmgmts:").InstancesOf("Win32_Process") 
      intProcessId = "" 
      For Each Process In Processes 
       If StrComp(Process.Name, "iexplore.exe", vbTextCompare) = 0 Then 
        intProcessId = Process.ProcessId 
        Exit For 
       End If 
      Next 
      If Len(intProcessId) > 0 Then 
       With CreateObject("WScript.Shell") 
        .AppActivate intProcessId 
       End With 
      End if 

      WScript.Sleep 3000 
      IE.ExecWB 6, 1 
      WScript.Sleep 5000 
      WshShell.SendKeys "{ENTER}" 
      WScript.Sleep 5000 


      'Activate PDFCreator window and click on save button 
      Set Processes = GetObject("winmgmts:").InstancesOf("Win32_Process") 
      intProcessId = "" 
      For Each Process In Processes 
       If StrComp(Process.Name, "PDFCreator.exe", vbTextCompare) = 0 Then 
        intProcessId = Process.ProcessId 
        Exit For 
       End If 
      Next 
      If Len(intProcessId) > 0 Then 
       With CreateObject("WScript.Shell") 
        .AppActivate intProcessId 
       End With 
      End If 

      WScript.Sleep 5000 
      WshShell.SendKeys "{ENTER}" 
      WScript.Sleep 5000 


      'Enter the save path and close Adobe and Internet Explorer 
      WshShell.SendKeys savepath & pdfname & ".pdf" 
      WScript.Sleep 5000 
      WshShell.SendKeys "{ENTER}" 
      WScript.Sleep 5000 
      WshShell.SendKeys "(%{F4})" 'ALT + F4 
      WScript.Sleep 5000 
      IE.Quit 
      WScript.Sleep 5000  

      'Check if new pdf exists or not in the folder, if so then quit from script 
      For i=0 to objFiles.Count 
       If Not objFso.FileExists(savepath & pdfname & ".pdf") Then 
         num = num - 1 
       End If 
      Next 

    num = num + 1 
Loop 
WScript.Sleep 5000 

ExcelObject.DisplayAlerts = False 
ExcelObject.Quit 
WScript.Quit 

Answer 1

多分あなたは部屋を使い果たしているかもしれません。あなたはオブジェクトを作成しているようですが、決してそれらを解放しません。おそらく "ie.quit"を追加してから、waitループをたどり、続いて "set ie = Nothing"を各ページを印刷した後に追加します。 または、各ループをcreateobjectせずにオブジェクトを再利用するだけです。