修改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

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

接下来要考虑的是导入 .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
'------------------------------

如果您对程序流程有所了解，请随时询问。