VBScript suddenly can't run macro after months of no issues - excel

Question

Base Problem
I have the following that runs daily on a schedule:
batch file --> vbscript --> two macros
However, after working without issue for months, I am now getting the following error:
1004: Cannot run the macro 'M1DelimiterSetupErrDescription'. The macro may not be available in this workbook or all macros may be disabled.
The above error is occurring on this line in the below VBScript:
ErrDescriptionResult = xlApp.Run ("M1DelimiterSetupErrDescription")
What I've Tried
Through trial and error, I've discovered several things:
Running the macros manually works, including M1DelimiterSetupErrDescription
Opening the .xlsm file as NOT read-only doesn't resolve the issue
Moving the problematic ErrDescriptionResult = xlApp.Run ("M1DelimiterSetupErrDescription") to an earlier location in the code, before the ErrNumberResult = xlApp.Run ("M1DelimiterSetupErrNumber") line, causes it to run without issue.
Opening the .xlsm file does bring up the yellow "Enable Macros" button/bar, but doesn't bring up the Trusted Document prompt after pushing the button. I don't know why that is - that's unusual.
Batch file:
pushd (directory)
cscript "Provider File Automation.vbs"
IF ERRORLEVEL 1 EXIT /b %ERRORLEVEL%
VBScript:
Option Explicit
Dim xlApp
Dim xlBook
Dim ErrNumberResult
Dim ErrDescriptionResult
'Have to use this for the Get Excel.Application lines
On Error Resume Next
'Make sure there's no error pre-registered for some reason
If Err.Number <> 0 Then Err.Clear
ErrNumberResult = 0
'Get Excel ready to work
Set xlApp = GetObject("","Excel.Application")
If xlApp <> "Microsoft Excel" Then Msgbox xlApp
If xlApp is Nothing Then Set xlApp = CreateObject("Excel.Application")
'Check for errors
If Err.Number <> 0 Then
Msgbox Err.Number & ": " & Err.Description & " The script will now quit."
WScript.Quit Err.Number
End If
'Change the delimiter
Set xlBook = xlApp.Workbooks.Open("(directory)\Provider File Automation v1.05.xlsm", 0, True)
ErrNumberResult = xlApp.Run ("M1DelimiterSetupErrNumber")
ErrDescriptionResult = xlApp.Run ("M1DelimiterSetupErrDescription")
If xlApp.Workbooks.Count = 1 Then xlApp.DisplayAlerts = False
xlApp.Quit
xlApp.DisplayAlerts = True
'Check for errors
If ErrNumberResult <> 0 Then
Msgbox ErrNumberResult & ": " & ErrDescriptionResult & " The script will now quit."
WScript.Quit ErrNumberResult
End If
Set xlBook = Nothing
Set xlApp = Nothing
'Get Excel ready to work again
Set xlApp = GetObject("","Excel.Application")
If xlApp <> "Microsoft Excel" Then Msgbox xlApp
If xlApp is Nothing Then Set xlApp = CreateObject("Excel.Application")
'Check for errors
If Err.Number <> 0 Then
Msgbox Err.Number & ": " & Err.Description & " The script will now quit."
WScript.Quit Err.Number
End If
'Create the provider file and change the delimiter back
Set xlBook = xlApp.Workbooks.Open("(directory)\Provider File Automation v1.05.xlsm", 0, True)
ErrNumberResult = xlApp.Run ("M2ProviderFileAutomationErrNumber")
ErrDescriptionResult = xlApp.Run ("M2ProviderFileAutomationErrDescription")
If xlApp.Workbooks.Count = 1 Then xlApp.DisplayAlerts = False
xlApp.Quit
xlApp.DisplayAlerts = True
'Check for errors
If ErrNumberResult <> 0 Then
Msgbox ErrNumberResult & ": " & ErrDescriptionResult & " The script will now quit."
WScript.Quit ErrNumberResult
End If
Set xlBook = Nothing
Set xlApp = Nothing
.xlsm module:
Option Explicit
Private Declare Function SetLocaleInfo _
Lib "kernel32" Alias "SetLocaleInfoA" ( _
ByVal Locale As Long, _
ByVal LCType As Long, _
ByVal lpLCData As String) As Boolean
Private Declare Function GetUserDefaultLCID% Lib "kernel32" ()
Private Const LOCALE_SLIST = &HC
Private Const LOCALE_NAME_USER_DEFAULT = vbNullString
'Private Const LOCALE_USER_DEFAULT = "0x0400"
'Get Locale Info
Private Declare Function GetLocaleInfoEx _
Lib "kernel32" ( _
ByVal lpLocaleName As String, _
ByVal LCType As Long, _
ByVal lpLCData As String, _
ByVal cchData As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Function M1DelimiterSetupErrNumber() As Long
M1ChangeDelimiterToPipe
M1DelimiterSetupErrNumber = Err.Number
End Function
Function M1DelimiterSetupErrDescription() As String
M1DelimiterSetupErrDescription = Err.Description
End Function
Sub M1ChangeDelimiterToPipe()
Dim lngTryAgainCtr As Long
Dim strListSeparator As String
Dim lpLCData As String
Dim Long1 As Long
lngTryAgainCtr = 0
TryAgain:
lngTryAgainCtr = lngTryAgainCtr + 1
'Change delimiter to pipe
' Call SetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SLIST, "|")
Call SetLocaleInfo(GetUserDefaultLCID(), LOCALE_SLIST, "|")
'Check to make sure setting separator as pipe worked correctly
Long1 = GetLocaleInfoEx(LOCALE_NAME_USER_DEFAULT, LOCALE_SLIST, lpLCData, 0)
'Make sure that Long1 came out with an appropriate value, exit with error number if it didn't
If Long1 = 0 Then
If lngTryAgainCtr < 3 Then
GoTo TryAgain
Else
Err.Number = 1
Err.Description = "GetLocaleInfoEx() failed, returned value of 0"
' MsgBox Err.Number & ": " & Err.Description & " The script will now quit."
Exit Sub
End If
Else
strListSeparator = String$(Long1, 0)
Long1 = GetLocaleInfoEx(LOCALE_NAME_USER_DEFAULT, LOCALE_SLIST, strListSeparator, Long1)
If InStr(strListSeparator, "|") = 0 Then
If lngTryAgainCtr < 3 Then
GoTo TryAgain
Else
If GetLocaleInfoEx(LOCALE_NAME_USER_DEFAULT, LOCALE_SLIST, strListSeparator, Long1) <> 0 Then Debug.Print GetLastError
Err.Number = 2
Err.Description = "Changing list separator to pipe unsuccessful."
' MsgBox Err.Number & ": " & Err.Description & " The script will now quit."
Exit Sub
End If
End If
'Close workbook to allow Excel to reset its memory of delimiter
'Show alerts if more workbooks open
' If Workbooks.Count = 1 Then Application.DisplayAlerts = False
' Application.Quit
End If
End Sub
Function M2ProviderFileAutomationErrNumber() As Long
M2ProviderFileAutomation
M2ProviderFileAutomationErrNumber = Err.Number
End Function
Function M2ProviderFileAutomationErrDescription() As String
M2ProviderFileAutomationErrDescription = Err.Description
End Function
Sub M2ProviderFileAutomation()
'
' M2ProviderFileAutomation Macro
'
' Keyboard Shortcut: Ctrl+Shift+W
'
Dim strProvFileSaveLoc As String 'Full File Name
Dim strProvFileUnzipped As String 'Location of Text File after Unzipping
Dim strProvFileEITcsv As String 'Location where csv is saved
Dim strProvFileWebAddr As String 'web address
Dim oXMLHTTP As Object
Dim Long1 As Long
Dim strListSeparator As String
Dim lpLCData As String
'Check to make sure Part 1 ran correctly and separator is pipe
Long1 = GetLocaleInfoEx(LOCALE_NAME_USER_DEFAULT, LOCALE_SLIST, lpLCData, 0)
'Make sure that Long1 came out with an appropriate value, exit with error number if it didn't
If Long1 = 0 Then
Err.Number = 1
Err.Description = "GetLocaleInfoEx() failed, returned value of 0"
' MsgBox Err.Number & ": " & Err.Description & " The script will now quit."
Exit Sub
Else
strListSeparator = String$(Long1, 0)
Long1 = GetLocaleInfoEx(LOCALE_NAME_USER_DEFAULT, LOCALE_SLIST, strListSeparator, Long1)
If InStr(strListSeparator, "|") = 0 Then
If GetLocaleInfoEx(LOCALE_NAME_USER_DEFAULT, LOCALE_SLIST, strListSeparator, Long1) <> 0 Then Debug.Print GetLastError
Err.Number = 3
Err.Description = "Part 2 detects non-pipe list separator."
' MsgBox Err.Number & ": " & Err.Description & " The script will now quit."
Exit Sub
Else
'Makes things go faster
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Save the provider file
strProvFileWebAddr = (web address)
strProvFileSaveLoc = (path)
strProvFileUnzipped = (path)
'Delete any in the way files
'Automated provider file folder - unzipped folder contents
If Dir(strProvFileUnzipped) <> "" Then
Kill strProvFileUnzipped
RmDir (path1)
RmDir (path2)
RmDir (path3)
RmDir (path4)
End If
'archive zip file
If Dir((potentially existing archive file path)) <> "" Then Kill ((potentially existing archive file path))
'archive text file
If Dir((potentially existing archive file2 path)) <> "" Then Kill ((potentially existing archive file2 path))
'You can also set a ref. to Microsoft XML, and Dim oXMLHTTP as MSXML2.XMLHTTP
Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
oXMLHTTP.Open "GET", strProvFileWebAddr, False 'Open socket to get the website
oXMLHTTP.Send 'send request
'Wait for request to finish
Do While oXMLHTTP.readyState <> 4
DoEvents
Loop
Dim oResp() As Byte
oResp = oXMLHTTP.responseBody 'Returns the results as a byte array
'Create local file and save results to it
Dim Int1 As Integer
Int1 = FreeFile()
If Dir(strProvFileSaveLoc) <> "" Then Kill strProvFileSaveLoc
Open strProvFileSaveLoc For Binary As #Int1
Put #Int1, , oResp
Close #Int1
'Clear memory
Set oXMLHTTP = Nothing
'Unzip zipped provider file
Dim objShell As Object
Set objShell = CreateObject("Shell.Application")
'Has to be variants, can't be strings
Dim varFLProviderFileAutomationFolder As Variant
varFLProviderFileAutomationFolder = (path)
Dim varProviderFileSaveLocation As Variant
varProviderFileSaveLocation = strProvFileSaveLoc
objShell.Namespace(varFLProviderFileAutomationFolder).CopyHere objShell.Namespace(varProviderFileSaveLocation).items
On Error Resume Next
Dim objFileSystemObject As Object
Set objFileSystemObject = CreateObject("scripting.filesystemobject")
objFileSystemObject.DeleteFolder Environ("Temp") & "\Temporary Directory*", True
On Error GoTo 0
'Excel changes to provider file
Workbooks.OpenText strProvFileUnzipped, DataType:=xlDelimited, _
TextQualifier:=xlTextQualifierDoubleQuote, Other:=True, Otherchar:="|", FieldInfo:=Array(Array(1, 2), _
Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2), _
Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2), Array(15, 2), Array(16, 2), _
Array(17, 2), Array(18, 2), Array(19, 2), Array(20, 2), Array(21, 2), Array(22, 2), Array(23, 2), _
Array(24, 2))
ActiveWorkbook.Sheets(1).Rows(1).Delete
ActiveWorkbook.Sheets(1).Columns("B:C").Replace What:="""", Replacement:="'", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
ActiveWorkbook.Sheets(1).Columns("G").Replace What:="""", Replacement:="'", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
strProvFileEITcsv = (path)
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=strProvFileEITcsv, FileFormat:=xlCSV, local:=True
Application.DisplayAlerts = True
'Don't have permission to copy from folder
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=(path), FileFormat:=xlCSV, local:=True
Application.DisplayAlerts = True
ActiveWorkbook.Close False
'Change delimiter back to comma
Call SetLocaleInfo(GetUserDefaultLCID(), LOCALE_SLIST, ",")
'Move zip file to archive
If Dir((potential archive file path)) = "" Then
Name strProvFileSaveLoc As (potential archive file path)
Else
Err.Number = 4
Err.Description = "Zip file already exists in archive."
' MsgBox Err.Number & ": " & Err.Description & " The script will now quit."
End If
'Move txt file to archive
If Dir((potential archive file2 path)) = "" Then
Name strProvFileUnzipped As (potential archive file2 path)
Else
If Err.Number <> 4 Then
Err.Number = 5
Err.Description = "Text file already exists in archive."
' MsgBox Err.Number & ": " & Err.Description & " The script will now quit."
GoTo SkipRMDir
Else
Err.Number = 6
Err.Description = "Zip and text files already exists in archive."
' MsgBox Err.Number & ": " & Err.Description & " The script will now quit."
GoTo SkipRMDir
End If
End If
'Cleanup
RmDir (path1)
RmDir (path2)
RmDir (path3)
RmDir (path4)
' MsgBox "Provider file done."
SkipRMDir:
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
'Show alerts if more workbooks open
' If Workbooks.Count = 1 Then Application.DisplayAlerts = False
' Application.Quit
End If
End If
End Sub

Answer 1

This stopped occurring as inexplicably as it started. Can no longer recreate. So I suppose one possible answer is just to wait.