修改VBS – Excelmacros循环应用于文件夹中的所有文件

我有一个脚本，将macros应用于多个Excel电子表格。 下面的代码打开特定的文件名并运行脚本。 我很想修改这个在指定文件夹内的所有xls文件上运行。 任何帮助将是伟大的！

Dim objExcel, objWorkbook, xlModule, strCode If ReportFileStatus("C:\Billing\Import\IL\3.xls") = "True" Then OpenFile "C:\Billing\Import\IL\3.xls, "" If ReportFileStatus("C:\Billing\Import\IL\3.xls") = "True" Then OpenFile "C:\Billing\Import\IL\3.xls", "" If ReportFileStatus("C:\Billing\Import\IL\3.xls") = "True" Then OpenFile "C:\Billing\Import\IL\3.xls", "" End If On Error Resume Next Set xlModule = Nothing Set objWorkbook = Nothing objExcel.Quit Set objExcel = Nothing On Error GoTo 0 '~~> Sub to open the file Sub OpenFile(sFile, DestFile) Set objExcel = CreateObject("Excel.Application") objExcel.Visible = false objExcel.DisplayAlerts = False Set objWorkbook = objExcel.Workbooks.Open(sFile) Set xlModule = objWorkbook.VBProject.VBComponents.Add(1) strCode = _ "Sub MACRO()" & vbCr & _ '~~> My Macro Here "End Sub" xlModule.CodeModule.AddFromString strCode objExcel.Run "MACRO" objWorkbook.Close (False) '<~~ Change false to true in case you want to save changes objExcel.Application.Quit End Sub '~~> Function to check if file exists Function ReportFileStatus(filespec) Dim fso, msg Set fso = CreateObject("Scripting.FileSystemObject") If (fso.FileExists(filespec)) Then msg = "True" Else msg = "False" End If ReportFileStatus = msg End Function 

谢谢

Answer 1

这个概念非常简单，给定一个文件夹path，处理其中的所有文件（或仅基于扩展名的某些文件）以及其子文件夹内的所有文件。 最简单的方法是recursion的subs和一个全局variables在单个线程中的函数 。

接下来要考虑的是导入 .bas文件，而不是尝试将文本添加到新模块。 您需要首先从模块导出工作代码。

下面假设根文件夹为“ C：\ Billing \ Import ”，导出的模块.bas文件为“ C：\ Test \ Module1.bas ”，您要执行的子名称为“ MACRO ”。

 Const sRootFolder = "C:\Billing\Import" Const sExportedModule = "C:\Test\Module1.bas" Const sMacroName = "MACRO" Dim oFSO, oFDR, oFile ' File and Folder variables Dim oExcel, oWB ' Excel variables (Application and Workbook) Start '------------------------------ Sub Start() Initialize ProcessFilesInFolder sRootFolder Finish End Sub '------------------------------ Sub ProcessFilesInFolder(sFolder) ' Process the files in this folder For Each oFile In oFSO.GetFolder(sFolder).Files If IsExcelFile(oFile) Then ProcessExcelFile oFile.Path Next ' Recurse all sub-folders from this folder For Each oFDR In oFSO.GetFolder(sFolder).SubFolders ProcessFilesInFolder oFDR.Path Next End Sub '------------------------------ Sub Initialize() Set oFSO = CreateObject("Scripting.FileSystemObject") Set oExcel = CreateObject("Excel.Application") End Sub '------------------------------ Sub Finish() oExcel.Quit Set oExcel = Nothing Set oFSO = Nothing End Sub '------------------------------ Function IsExcelFile(oFile) IsExcelFile = (InStr(1, oFSO.GetExtensionName(oFile), "xls", vbTextCompare) > 0) And (Left(oFile.Name, 1) <> "~") End Function '------------------------------ Sub ProcessExcelFile(sFileName) On Error Resume Next wscript.echo "Processing file: " & sFileName ' Comment this unless using cscript in command prompt Set oWB = oExcel.Workbooks.Open(sFileName) oWB.VBProject.VBComponents.Import sExportedModule oExcel.Run sMacroName oWB.Close Set oWB = Nothing End Sub '------------------------------ 

随意问你是否理解了程序stream程。