简体   繁体   中英

VBS apply Excel VBA macro to all files in current directory

I try to apply a VBA macro kept in personl.xls to all files in a given directory, but I hit an error in line 29.. I'm afraid I got things mixed up here:

Option Explicit
On Error Resume Next

Dim xlApp
Dim xlBook

Dim No_Of_Files
Dim i
Dim File_Path

Set xlApp = CreateObject("Excel.Application")
xlApp.DisplayAlerts = True

File_Path = "C:\Dokumente und Einstellungen\kcichini\Eigene Dateien\Stuff\Test\"

With xlApp.FileSearch
  .NewSearch
  .LookIn = File_Path
  .Filename = "*.xls"
  .SearchSubFolders = False
  .Execute

  No_Of_Files = .FoundFiles.Count

  For i = 1 To No_Of_Files
    Set xlBook = xlApp.Workbooks.Open(.FoundFiles(i), 0, False) 
    xlApp.Run "'C:\Dokumente und Einstellungen\kcichini\Anwendungsdaten\Microsoft\Excel\XLSTART\PERSONL.XLS'!SASXLSFormat" 
    xlApp.ActiveWorkbook.Close
  Next i

End With

xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing

I obviously was on a completedly wrong track. But this seems to work properly:

Option Explicit
On Error Resume Next

Dim xlApp
Dim xlBook
Dim sPath

Dim fso
Dim ObjFolder
Dim ObjFiles
Dim ObjFile

'make an object with the excel application 
Set xlApp = CreateObject("Excel.Application")
xlApp.DisplayAlerts = True

'Creating File System Object
Set fso = CreateObject("Scripting.FileSystemObject")

'Getting the Folder Object
Set ObjFolder = fso.GetFolder("C:\Dokumente und Einstellungen\kcichini\Eigene Dateien\Stuff\Test")

'Getting the list of Files
Set ObjFiles = ObjFolder.Files

'Running the macro on each file 
For Each ObjFile In ObjFiles
    'MsgBox (ObjFolder & "\" & ObjFile.Name)
    Set xlBook = xlApp.Workbooks.Open(ObjFolder & "\" & ObjFile.Name, 0, False) 
    xlApp.Run "'C:\Dokumente und Einstellungen\kcichini\Anwendungsdaten\Microsoft\Excel\XLSTART\PERSONL.XLS'!SASXLSFormat" 
    xlApp.xlBook.Close
Next

xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM