Vbscript pdf speichern von Internet Explorer

Question

Ich schrieb ein Skript, das eine Excel-Datei öffnet, die Hyperlinks enthält. Vbscript öffnet einen Hyperlink mit dem Internet Explorer und speichert die Seite als PDF mit dem PDF Creator als Standarddrucker. Es befindet sich in einer Schleife. Mein Problem ist, dass das Skript jedes Mal in einem anderen Schritt fehlschlägt. Ich weiß nicht, wie ich dieses Skript umschreiben könnte, um es zu einem stabilen zu machen.

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

Vielleicht haben Sie keinen Platz mehr. Du scheinst Dinge zu erschaffen, aber niemals loszulassen. Vielleicht fügen Sie eine "ie.quit" hinzu, gefolgt von einer Warteschleife, gefolgt von "set ie = Nothing", wenn Sie jede Seite gedruckt haben. Oder einfach das Objekt ohne createobject jede Schleife wiederverwenden.