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

Question

我有一个将宏应用于多个 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

这个概念非常简单，给定一个文件夹路径，处理其中的所有文件（或仅基于扩展名的某些文件），以及它的子文件夹中的所有文件。最简单的方法是在单个线程中使用一些全局变量递归子和函数。

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

以下假设根文件夹为“C:\Billing\Import”，导出的模块.bas文件为“C:\Test\Module1.bas” ，而您要执行的 Sub 名称是“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
'------------------------------

如果您无法理解程序流程，请随时询问。