VBS将Excel VBA宏应用于当前目录中的所有文件

时间:2012-12-10 11:49:36

标签: excel vba vbscript

我尝试将保存在personl.xls中的VBA宏应用于给定目录中的所有文件, 但我在第29行遇到了错误.. 我担心我把事情搞混了:

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

1 个答案:

答案 0 :(得分:0)

我显然是在完全错误的轨道上。 但这似乎运作正常:

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