Excel mit VBS bearbeiten und Speichern Unter

'Pfad zu den Dokumenten  
Const strPathDocs = "D:\Mess-Dateien"  
'Logfile für eventuell auftretende Fehler  
Const strPathLogfile = "D:\logfile.txt"  
'Erweiterungen der Dateien die bearbeitet werden sollen  
arrFileExtensions = Array("doc","docm","xlsm","xls","csv")  

Set fso = Wscript.CreateObject("Scripting.Filesystemobject")  
Set objShell = CreateObject("Wscript.Shell")  
Dim intDocCount, intErrCount, objExcel, objWord
Set objExcel = CreateObject("Excel.Application")  
Set objWord = WScript.CreateObject("Word.Application")  
'Applikation anzeigen und eventuelle Dialoge für Batchbetrieb unterdrücken  
objExcel.Visible = True
objExcel.DisplayAlerts = 0
objWord.Visible = True
objWord.DisplayAlerts = 0

'Im Ordner Rekursiv alle Dokumente mit den angegebenen Extensions verarbeiten  
parseFolders fso.GetFolder(strPathDocs), True

objExcel.DisplayAlerts = True
objExcel.Quit
objWord.DisplayAlerts = True
objWord.Quit

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

Set objShell = Nothing
Set objWord = Nothing
Set objExcel = Nothing
Set fso = Nothing
'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)) And file.DateLastModified > DateAdd("m",-1,Now()) Then  
				intDocCount = intDocCount + 1 
				Select Case Left(LCase(fso.GetExtensionName(file.Path)),2)
					Case "xl"	' wenn es ein Excel-Workbook ist ....  
						
						'Fehlerbehandlung für den Fall das ein Fehler beim Öffnen eines Dokumentes auftritt  
						On Error Resume Next
			            Set objWB = objExcel.Workbooks.Open(file.Path)
			            If Err.Number <> 0 Then
			            	intErrCount = intErrCount + 1
			            	WriteLog "!!ERROR!! Fehler beim öffnen der Datei: -> '" & file.Path & "'"  
                                        Err.Clear
			            Else
			            	' Funktion im Workbook ausführen  
			            	With objWB.Sheets(1).Range("A:A")  
							Set f = .Find("Trace", , -4163, 2)  
								If Not f Is Nothing Then
									Range("1:" & f.Row - 1).Delete  
								End If
							End With
			            	'-------------------------------  
			            	objWB.Save
			            	objWB.Close
			            	WriteLog "Workbook wurde verarbeitet: ->'" & file.Path & "'"  
			            End If
						
						
					Case "do"	' wenn es ein Word-Dokument ist ....  
						
						'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 & "'"  
                                        Err.Clear
			            Else
			            	'Funktion ausführen  
			            	objWord.Run "Modul1.MyTestModul"  
			            	'------------------  
			            	objDoc.Save
			            	objDoc.Close
			            	WriteLog "Dokument wurde verarbeitet: ->'" & file.Path & "'"  
			            End If
			            
				End Select
				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