運行時錯誤VBS / VBA

Question

直到我嘗試添加錯誤處理（VBA中的webquery不會拉回任何數據時），這段代碼才能正常工作。 現在它仍然可以運行，但是出現以下錯誤：

Script: C:\Test\test.vbs
Line: 8
Char: 1
Error: Cannot access 'Test.xlsm'.
Code: 800A9C68
Source: Microsoft Excel

這是我的VBScript，實際上只是在.xlsm工作簿中調用我的VBA

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

以下是我的VBA代碼，它刷新了Web查詢，重新格式化了一些小的格式化錯誤，然后將工作表另存為.csv在當前目錄中。

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

我試圖做的錯誤處理就是以下幾方面：

'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

Answer 1

好吧，終於得到了...。由於某種原因，如果我在Excel中拆分了VBA代碼的一部分，該部分將工作簿保存到新的宏中，那么我將不再收到錯誤。

所以我最終得到了3個宏。 Lable1之上的部分，然后是Lable1，以及另一個宏，它們按照應該運行的順序調用這兩個宏。

同樣對於錯誤處理，我缺少Exit Sub命令以在沒有錯誤時停止執行它。

感謝您的所有幫助！