VBS: Selfbuilded PDF Print, Split Merge - Bitte um code improvement

[amn.ssy]

hallo und guten Morgen,

im Rahmen eines größeren Projektes ist der nachfolgende Code entstanden.
Hierbei geht es darum, daß in einem Verzeichnis Reports abgelegt werden, deren jeweils letzte Seite ausgedruckt werden soll.
Später werden diese Seiten in bestimmter Reihenfolge wieder eingescannt und als einzige Datei ebenfalls abgelegt.
Das Script splittet diesen Scan auf und merged anschleißend die Einzeldateien mit den vorhandenen Reports (die jeweils letzte Seite wird ausgetauscht). Im Vorletzen Schritt werden die "neu" entstandenen PDF-Dateien gespeichert und zu guter letzt an ein Mail-Template im Outlook angehängt.
Ich würde mich freuen wenn ihr mal drüberschaut und mir euere Meinung, Kritiken und Verbesserungsvorschläge mitteilt.
Etwas unsicher bin ich vorallem beim Schließen der Objekte, welche müßen unbedingt geschlossen werden, damit das Script sauber beendet ist und welche können eher vernachlässigt werden? Mit den Variablen und Objeten hab ich's möglicherweise auch etwas übertrieben ;-)
Grundsätzlich läuft das Script schon sehr gut, hat jedoch noch den Harken, daß ich die "Funktionen" bisher nur im einzelnen ausführen kann; Zunächst nur Print laufen lassen, danach diesen Aufruf auskommentieren und merge\mail aktivieren.
Ansonsten erhalte ich einen Indexfehler in der Schleife ab 126. Wieso läuft's im Einzelnen und nicht insgesamt in einem Rutsch durch?

Option Explicit

Dim ObjFSO, ObjFile, ObjFolderInp, ObjFolderOut, ObjFolderRep, ObjFolderSig, ObjFolderTmp
Dim ObjOlApp, ObjOlMail, ObjAcApp, ObjAcAVDoc, ObjAcPDDoc, ObjAcJSO, ObjACpp, ObjAcBaseFile, ObjAcInsertFile
Dim ParentFolder, FolderInp, FolderOut, FolderPro, FolderRep, FolderSig, FolderTmp, MailTemplate, FileMonth, SignPage
Dim prtSig, LogFile
Dim FoInp(), FoOut(), FoRep(), FoSig(), RepName(), FileExt(), NewRepName()
Dim h, i, j, k, l, m, endPage, startPage

Set ObjFSO = CreateObject("Scripting.FileSystemObject")
Set ObjFile  = CreateObject("Scripting.FileSystemObject")

ParentFolder = ObjFSO.GetParentFolderName(Wscript.ScriptFullName)

'// alternativ mit GetAbsolutePathName ansteuern
FolderInp = ParentFolder & "\Input"
FolderOut = ParentFolder & "\Output"
FolderPro = ParentFolder & "\Prog"
FolderRep = ParentFolder & "\Reports"
FolderSig = ParentFolder & "\SignPg"
FolderTmp = ParentFolder & "\Temp"

	If Not ObjFSO.FolderExists(FolderInp) Or Not ObjFSO.FolderExists(FolderOut) _
	Or Not ObjFSO.FolderExists(FolderRep) Or Not ObjFSO.FolderExists(FolderSig) Then
		MsgBox "min. ein Verzeichnis existiert nicht!",vbCritical,""
		Set ObjFile  = Nothing
		Set ObjFSO = Nothing
		WScript.Quit

	Else

		Set ObjFolderInp = ObjFSO.Getfolder(FolderInp)
		Set ObjFolderOut = ObjFSO.Getfolder(FolderOut)
		Set ObjFolderRep = ObjFSO.Getfolder(FolderRep)
		Set ObjFolderSig = ObjFSO.Getfolder(FolderSig) 
        Set ObjFolderTmp = ObjFSO.Getfolder(FolderTmp)
	
	End If

printPages()
mergePages()
sendPages()

Function printPages()

Set ObjAcApp = CreateObject("AcroExch.App") 
Set ObjAcAVDoc = CreateObject("AcroExch.AVDoc")

Redim FoRep(ObjFolderRep.files.count -1)

	For Each ObjFile In ObjFolderRep.Files
		FoRep(i) = ObjFile.Name    
		i=i+1
	Next

    If ObjFSO.FileExists(FolderTmp & "\prt.sig") then
    MsgBox "Files already printed",vbInformation,""
		
		mergePages()
  
	Else
  
		For j = LBound(FoRep) To UBound(FoRep)
			ObjAcAVDoc.Open FolderRep & "\" & FoRep(j),""
			Set ObjAcPDDoc = ObjAcAVDoc.GetPDDoc
			Set ObjAcJSO = ObjAcPDDoc.GetJSObject
			'** ObjAcJSO.print("bUI","nStart","nEnd","bSilent","bShrinkToFit","bPrintAsImage","bReverse","bAnnot","bprintParams")
			endPage = ObjAcJSO.numPages - 1
			startPage = endPage 
			Set ObjACpp = ObjAcJSO.getPrintParams()
			ObjACpp.printerName = ""
			MsgBox FolderRep & Chr(13) & FoRep(j) & Chr(13) & "Seite: " & endPage +1 '<-- Kontrollausgabe
			'ObjAcJSO.print False,startPage,endPage,False,True,False,False,False,ObjACpp
			ObjAcApp.CloseAllDocs
			ObjAcApp.Exit
		Next
  
	Set prtSig = ObjFSO.CreateTextFile(FolderTmp & "\prt.sig", true)
	prtSig.Close
  
  End If
  
  i = 0
  j = 0
	
Set ObjACpp = Nothing
Set ObjAcJSO = Nothing 
Set ObjAcPDDoc = Nothing 
Set ObjAcAVDoc = Nothing 
Set ObjAcApp = Nothing

End Function

Function mergePages()

Set ObjAcApp = CreateObject("AcroExch.App") 
Set ObjAcAVDoc = CreateObject("AcroExch.AVDoc")
Set ObjAcBaseFile = CreateObject("AcroExch.PDDoc") 
Set ObjAcInsertFile = CreateObject("AcroExch.PDDoc")

Redim FoInp(ObjFolderInp.files.count -1)

	For Each ObjFile In ObjFolderInp.Files
		FoInp(h) = ObjFile.Name	
		h=h+1
	Next
	
	If ObjFolderInp.Files.count = 0 then
    MsgBox "No files in Input-Folder",vbInformation,""
		
		Set ObjAcInsertFile = Nothing
		Set ObjAcBaseFile = Nothing
		Set ObjAcAVDoc  = Nothing
		Set ObjAcApp = Nothing
	    WScript.Quit
  
	Else

Redim FoRep(ObjFolderRep.files.count -1)
Redim RepName(ObjFolderRep.files.count -1)
Redim FileExt(ObjFolderRep.files.count -1)
Redim NewRepName(ObjFolderRep.files.count -1)

	For Each ObjFile In ObjFolderRep.Files
		FoRep(i) = ObjFile.Name
		RepName(i) = ObjFSO.GetBaseName(ObjFile)
		FileExt(i) = ObjFSO.GetExtensionName(ObjFile)
		NewRepName(i) = RepName(i) & "_FINAL." & FileExt(i)
		FileMonth = Mid(RepName(i), 21)
		i=i+1
    Next

	For j = LBound(FoInp) To UBound(FoInp) 
		ObjAcAVDoc.Open FolderInp & "\" & FoInp(j),""
		Set ObjAcPDDoc = ObjAcAVDoc.GetPDDoc() 
		Set ObjAcJSO = ObjAcPDDoc.GetJSObject
		
		For k = 0 To ObjAcJSO.numPages - 1 
			SignPage = FolderSig & "\SignPage_" & right(k + 1001,3) & ".pdf" 
			ObjAcJSO.extractPages k, k, SignPage
		Next

 		ObjAcApp.CloseAllDocs
		ObjAcApp.Exit
		
	Next
	
Redim FoSig(ObjFolderSig.files.count -1)

	For Each ObjFile In ObjFolderSig.Files
		FoSig(l) = ObjFile.Name
		l=l+1	
	Next
	
	For m = LBound(FoRep) To UBound(FoRep)
		ObjAcBaseFile.Open FolderRep & "\" & FoRep(m)
		endPage = ObjAcBaseFile.GetNumPages() - 1
		ObjAcInsertFile.Open FolderSig & "\" & FoSig(m)
		ObjAcBaseFile.ReplacePages endPage, ObjAcInsertFile, 0, ObjAcInsertFile.GetNumPages, 0
		ObjAcBaseFile.Save &H1, FolderOut & "\" & NewRepName(m)
		ObjAcBaseFile.Close
		ObjAcInsertFile.Close
		ObjAcApp.Exit
	Next
	
End If
	
	h = 0
	i = 0
	j = 0
	k = 0
	l = 0
    m = 0
	
Set ObjAcJSO = Nothing 
Set ObjAcPDDoc = Nothing 
Set ObjAcAVDoc = Nothing 
Set ObjAcApp = Nothing

End Function	

Function sendPages()

Const olByValue = 1
Const olMailItem = 0
MailTemplate = FolderPro & "\Brufen Reports Month completed.oft"

Set ObjOlApp = CreateObject("Outlook.Application")
Set ObjOlMail = ObjOlApp.CreateItemFromTemplate(MailTemplate)

Redim FoOut(ObjFolderOut.files.count -1)

	For Each ObjFile In ObjFolderOut.Files
		FoOut(i) = ObjFile.Name
		i=i+1
	Next

	With ObjOlMail   
        	ObjOlMail.Subject = Replace(ObjOlMail.Subject, "Month", FileMonth)
        	ObjOlMail.HTMLBody = Replace(ObjOlMail.HTMLBody, "Month", FileMonth)
			
		For j = LBound(FoOut) To UBound(FoOut)
		.Attachments.Add FolderOut & "\" & FoOut(j), olByValue, 1
		Next
		
	End With

	ObjOlMail.Display
	'ObjOlMail.Send
	
	i = 0
	j = 0

Set ObjOlMail = Nothing
Set ObjOlApp = Nothing

End Function

Set ObjFile = Nothing
Set ObjFSO = Nothing
WScript.Quit

Vielen Dank im Voraus
opiWahn

 

[HonniCilest]

Ich tue mich ganz ganz schwer mit diesen vielen Schleifen, sind die wirklich alle notwendig? Für mich wirkt auf den ersten Blick vieles überflüssig.
Ich meine hier z.B. Zeile 51-54. Du verwendest eine Iterationsschleife und speicherst die Namen in ForRep ab. Später (Zeile 63ff.) verwendest du eine Indexschleife, welche zwangsläufig die selbe Länge haben muss (oder irre ich mich hier?) und du auf ForRep zugreifst. Wieso machst du erst den ersten Schritt anstatt beides in einem Durchlauf vorzunehmen? Das erschließt sich mir nicht. Das Szenario wiederholt sich im Laufe des Skriptes mehrmals.
Desweiteren fällt mir auf, funktioniert ReDim mit einem Negativen Wert? Denn wenn Zeile 108 True liefert, dann müsste vorhergehend meiner Meinung nach Zeile 101 fehlschlagen.