Konvertierung ganzer Ordnerstruktur in PDF (Word-Dateien)

'Pfad zu den Dokumenten  
Const strPathDocs = "C:\Ordner\Daten"  
'Logfile für eventuell auftretende Fehler  
Const strPathLogfile = "c:\Ordner\Daten\logfile.txt"  
'Erweiterungen der Dateien die bearbeitet werden sollen  
arrFileExtensions = Array("doc","docx","docm")  
' -------------------------------------------------  
Set fso = CreateObject("Scripting.Filesystemobject")  
Set objWord = CreateObject("Word.Application")  
Set objShell = CreateObject("Wscript.Shell")  
Dim intDocCount, intErrCount
'Applikation anzeigen und eventuelle Dialoge für Batchbetrieb unterdrücken  
objWord.Visible = True
objWord.DisplayAlerts = 0
'Im Ordner Rekursiv alle Word-Dokumente verarbeiten  
parseFolders fso.GetFolder(strPathDocs), True
'Das Anzeigen von Benachrichtigungen wieder aktivieren und Word schließen  
objWord.DisplayAlerts = -1
objWord.Quit True
Set fso = Nothing
Set objWord = Nothing
If intErrCount = 0 Then
	MsgBox "Es wurden insgesamt " & intDocCount & " Dokumente verarbeitet.", vbInformation, "Verarbeitung abgeschlossen"  
Else
	MsgBox "Es wurden insgesamt " & intDocCount & " Dokumente verarbeitet." & vbCrLf & "Davon ist bei " & intErrCount & " Dokumenten ein Fehler aufgetreten!", vbInformation, "Verarbeitung abgeschlossen"  
	objShell.Run "Notepad.exe " & strPathLogfile  
End If

'Ende  

Function parseFolders(fldr, boolRecursion)
    For Each file In fldr.Files
    	For i = 0 To UBound(arrFileExtensions)
			If LCase(arrFileExtensions(i)) = LCase(fso.GetExtensionName(file.Path)) Then
				intDocCount = intDocCount + 1 
	            'Fehlerbehandlung für den Fall das ein Fehler beim Öffnen eines Dokumentes auftritt  
	            On Error Resume Next
	            Set objDoc = objWord.Documents.Open(file.Path)
	            If Err.Number <> 0 Then
	            	intErrCount = intErrCount + 1
	            	WriteLog "!!ERROR!! Fehler beim öffnen der Datei: -> '" & file.Path & "'"  
	            Else
	            	'----- Dokument als PDF speichern -----------  
	            	strPathPDF = file.ParentFolder & "\" & fso.GetBasename(file.Path) & ".pdf"  
	            	objDoc.SaveAs strPathPDF,17
	            	objDoc.Close
	            	WriteLog "Dokument wurde zu PDF konvertiert: ->'" & file.Path & "' --> '" & strPathPDF & "'"  
	            End if
	            Exit For
	         End If
		Next
    Next
    
    'Funktion wird rekursiv aufrufen wenn das durchsuchen aller Unterordner gewünscht ist  
    If boolRecursion Then
		For Each subFolder in fldr.SubFolders
			parseFolders subFolder, True
		Next
	End If
End Function

Function WriteLog(strText)
	Set objLog = fso.OpenTextFile(strPathLogfile,8,True)
	logline = Now & " - " & strText  
	objLog.WriteLine(logline)
	objLog.Close
End Function