Modify VBS – Excel Macro Loop Apply to all files in folder

Question

I have a script that applies a macro to multiple excel spreadsheets. The code below opens specific file names and runs the script. I would love to modify this to run on all xls files within a specified folder. Any help would be great!

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

Thanks

Answer 1

The concept is pretty simple, given a folder path, process all files in it (or only certain files based on extension), and all files within it's subfolder. The simplest method is recursive subs and functions with some global variables in a single thread.

The next thing to consider is to Import .bas file instead of trying to add text to a new module. You need to export a working code from a Module first.

Below assumed the root folder to be "C:\Billing\Import", the exported module .bas file is "C:\Test\Module1.bas", and the Sub name you want to execute is "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
'------------------------------

Feel free to ask if you get stuck understanding the program flow.