Trouble running a VBA macro from VBS

Question

I'm writing a script in VBS to run a macro on many excel files in a directory. I'm new to VBS and macros.

The root directory has a number of folders in it. Inside each folder is a number of sub folders. I'm looking for folders at this level called "inspection". Inside of those folders I'm looking for files that match the pattern .050. or .120.. If those files are found I want to run an Excel macro on them to modify the footer.

I've managed to set up all of the logic to search for the files and that seems to be working. I've got a macro recorded in my PERSONAL.XLSB file and I can open files individually and run the macro successfully.

The problem: When I try to call the macro from code I get the following error:

Cannot run the macro
The macro may not be available in this workbook or all macros may be disabled.

I have macros enabled in Excel. I've tried a number of methods for running the macro but haven't been able to get any to work.

My VBS script:

DIM FSO, rootFolder, subFolders, subFolder, inspectionFolders, inspectionFolder, inspectionFiles, inspectionFile, wb

Set FSO = CreateObject("Scripting.FileSystemObject")
Set rootFolder = FSO.GetFolder("N:\ENGINEERING-Test")

Set subFolders = rootFolder.SubFolders

For Each subFolder in subFolders
    WScript.Echo "in " + rootFolder
    WScript.Echo "found folder " + subFolder.Name
    Set inspectionFolders = subFolder.SubFolders
    For Each inspectionFolder in inspectionFolders
        WScript.Echo "found folder " + inspectionFolder.name
        If InStr(1, inspectionFolder.Name, "Inspection", vbTextCompare) Then
            WScript.Echo "In inspection Folder"
            Set inspectionFiles = inspectionFolder.files
            For Each inspectionFile in inspectionFiles
                WScript.Echo "Checking File " + inspectionFile.name
                If InStr(1, inspectionFile.Name, ".050.", vbTextCompare) > 0 Or InStr(1, inspectionFile.Name, ".120.", vbTextCompare) > 0 Then
                    WScript.Echo "Found file " + inspectionFile.name

                    Set xlApp = CreateObject("Excel.application")
                    Set xlBook = xlApp.Workbooks.Open(inspectionFolder & "\" & inspectionFile.name, 0, False)
                    xlApp.Application.Visible = False
                    xlApp.Application.Run "C:\Users\Nick\AppData\Roaming\Microsoft\Excel\XLSTART\PERSONAL.XLSB!Module1.ModifyHeaderFooter"
                    xlApp.ActiveWindow.close
                    xlApp.Quit

                Else
                End If
            Next
        Else
        End If
    Next
Next

My macro:

Sub ModifyHeaderFooter()
'
' ModifyHeaderFooter Macro
'

'
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$3"
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "Company, LLC"
        .RightFooter = "Page &P of  &N&8" & Chr(10) & ""
        .LeftMargin = Application.InchesToPoints(0.45)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0.58)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 300
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = False
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
End Sub

At this point I'm able to find the files I'm looking for, and the script attempts to execute the macro, but I get an error. Can anyone see what I'm doing wrong?

You'll need to open your Personal.xlsb workbook inside the excel instance created by the VBS script. I would also suggest refactoring the vbscript to open the Excel instance outside the loop and only opening the workbook in the loop. this way you are not creating and destroying the excel object needlessly every loop. Then I suggest refactoring the macro in your workbook to accept a wb object as an argument to act upon and not use ActiveSheet. — Scott Holtzman
Thanks. So should I move Set xlApp = CreateObject("Excel.application") above the first loop? Can I then use xlApp.Workbooks.Open("C:\Users\Nick\AppData\Roaming\Microsoft\Excel\XLSTART\PERSONAL.XLSB") to open my Personal.xlsb workbook once at that point as well? — NickBonnell

garbb garbb · Accepted Answer · 2017-12-04T19:35:35

0

votes

Try just xlApp.Run("PERSONAL.XLSB!ModifyHeaderFooter")

Trouble running a VBA macro from VBS

2 Answers