简体   繁体   English

运行时错误VBS / VBA

[英]Runtime Error VBS/VBA

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). 直到我尝试添加错误处理(VBA中的webquery不会拉回任何数据时),这段代码才能正常工作。 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 这是我的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

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. 以下是我的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

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. 好吧,终于得到了...。由于某种原因,如果我在Excel中拆分了VBA代码的一部分,该部分将工作簿保存到新的宏中,那么我将不再收到错误。

So I ended up with 3 Macros. 所以我最终得到了3个宏。 The portion above Lable1, then Lable1 and another macro that calls both of those macros in the order they are supposed to run. Lable1之上的部分,然后是Lable1,以及另一个宏,它们按照应该运行的顺序调用这两个宏。

Also for the error handling, I was missing the Exit Sub command to stop it from executing when there is no error. 同样对于错误处理,我缺少Exit Sub命令以在没有错误时停止执行它。

Thanks for all the help! 感谢您的所有帮助!

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM