This code was working perfectly until I tried to add error handling (for when the webquery in the VBA didn't pull back any data). Now it still runs, but I get the following error:
Script: C:\Test\test.vbs
Line: 8
Char: 1
Error: Cannot access 'Test.xlsm'.
Code: 800A9C68
Source: Microsoft Excel
This is my VBScript, which essentially just calls my VBA inside of the .xlsm workbook
Set fso = CreateObject("Scripting.FileSystemObject")
curDir = fso.GetAbsolutePathName(".")
Set myxlApplication = CreateObject("Excel.Application")
myxlApplication.Visible = False
Set myWorkBook = myxlApplication.Workbooks.Open( "C:\Test\Test.xlsm" ) 'Change to the actual workbook that has the Macro
myWorkBook.Application.Run "Module1.Mail_ActiveSheet" 'Change to the Module and Macro that contains your macro
myxlApplication.Quit
The following is my VBA code that refreshes the webquery, re-formats some small formatting errors then saves the sheet as .csv in the current directory.
Private Declare Function GetActiveWindow Lib "user32" () As Long
Sub Mail_ActiveSheet()
' Error Handling
On Error GoTo Errhandler
' Refreshes webquery
Application.Worksheets("Test").Range("A1").QueryTable.Refresh BackgroundQuery:=False
' Enters Title Comments in Cell M2
Range("$M$2").Value = "Notes"
' Enters formula in column M
Range("$M$3").Formula = Range("G3") & (":") & Range("L3")
Dim Lastrow As Long
Application.ScreenUpdating = False
Lastrow = Range("L" & Rows.Count).End(xlUp).Row
Range("M3:M" & Lastrow).Formula = "=""TT""&G3&"":""&L3"
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True
' Replaces comma's with periods
Cells.Replace What:=",", Replacement:=".", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' Formats column H as text
Range("E:E").NumberFormat = "General"
Range("H:H").NumberFormat = "@"
' Fixes formatting adding leading zeros to site codes
Columns("H").Replace What:="808", LookAt:=xlWhole, Replacement:="'0808", SearchOrder:=xlByColumns
Columns("H").Replace What:="650", LookAt:=xlWhole, Replacement:="'65E1", SearchOrder:=xlByColumns
Columns("H").Replace What:="941", LookAt:=xlWhole, Replacement:="'0941", SearchOrder:=xlByColumns
Columns("H").Replace What:="17", LookAt:=xlWhole, Replacement:="'0017", SearchOrder:=xlByColumns
Columns("H").Replace What:="168", LookAt:=xlWhole, Replacement:="'0168", SearchOrder:=xlByColumns
Columns("H").Replace What:="420", LookAt:=xlWhole, Replacement:="'0420", SearchOrder:=xlByColumns
Columns("H").Replace What:="535", LookAt:=xlWhole, Replacement:="'0535", SearchOrder:=xlByColumns
Columns("H").Replace What:="560", LookAt:=xlWhole, Replacement:="'0560", SearchOrder:=xlByColumns
Columns("H").Replace What:="572", LookAt:=xlWhole, Replacement:="'0572", SearchOrder:=xlByColumns
Columns("H").Replace What:="575", LookAt:=xlWhole, Replacement:="'0575", SearchOrder:=xlByColumns
Columns("H").Replace What:="750", LookAt:=xlWhole, Replacement:="'0750", SearchOrder:=xlByColumns
Columns("H").Replace What:="760", LookAt:=xlWhole, Replacement:="'0760", SearchOrder:=xlByColumns
Columns("H").Replace What:="815", LookAt:=xlWhole, Replacement:="'0815", SearchOrder:=xlByColumns
Columns("H").Replace What:="822", LookAt:=xlWhole, Replacement:="'0822", SearchOrder:=xlByColumns
Columns("H").Replace What:="823", LookAt:=xlWhole, Replacement:="'0823", SearchOrder:=xlByColumns
Columns("H").Replace What:="824", LookAt:=xlWhole, Replacement:="'0824", SearchOrder:=xlByColumns
Columns("H").Replace What:="886", LookAt:=xlWhole, Replacement:="'0886", SearchOrder:=xlByColumns
Lable1:
Dim WS As Excel.Worksheet
Dim SaveToDirectory As String
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
' Store current details for the workbook
SaveToDirectory = "C:\Test\"
For Each WS In ThisWorkbook.Worksheets
Sheets(WS.Name).Copy
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & WS.Name & ".csv", FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Next
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = True
' Temporarily turn alerts off to prevent the user being prompted
' about overwriting the original file.
End
Errhandler:
Sheet1.Cells.Clear
Resume Label1 'Lable1 is placed before the place the workbook is saved
End Sub
The error handling that I was trying to do, was something along these lines:
'This was placed above the webquery portion of the script
On Error GoTo Errhandler
Errhandler:
Sheet1.Cells.Clear
Resume Label1 'Lable1 is placed before the place the workbook is saved
Alright, finally got it.... For some reason, if I split the portion of the VBA code in Excel that saves the workbook to a new macro I no longer get the error.
So I ended up with 3 Macros. The portion above Lable1, then Lable1 and another macro that calls both of those macros in the order they are supposed to run.
Also for the error handling, I was missing the Exit Sub command to stop it from executing when there is no error.
Thanks for all the help!
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.