运行时错误 VBS/VBA答案

【问题标题】：Runtime Error VBS/VBA运行时错误 VBS/VBA
【发布时间】：2015-08-10 23:51:15
【问题描述】：

在我尝试添加错误处理之前，这段代码运行良好（当 VBA 中的 web 查询没有拉回任何数据时）。现在它仍然运行，但我收到以下错误：

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 代码，它刷新 webquery，重新格式化一些小的格式错误，然后将工作表保存为当前目录中的 .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

【问题讨论】：

您有多少次打开 XLSM（不可见性）并在尝试再次打开之前未将其关闭？如果打开任务管理器，进程选项卡上有多少 Excel.exe 条目？
在我关闭 excel 后，我通常在任务管理器中还有 1 个打开。但无法弄清楚是什么导致它保持打开状态。
尝试在最后设置 myxlApplication = Nothing
听起来好像您有一个未关闭的不可见 Excel.Application 并且其中可能打开了 C:\Test\Test.xlsm 文件。在您摆脱它之前，您将无法再次打开它；可能是通过使用任务管理器将其关闭。我看不到你在哪里关闭ThisWorkbook，只是ActiveWorkbook。
刮掉我留下的最后一条评论......此时可能应该再喝点咖啡......在VBScript结束时尝试过，但没有运气摆脱错误。

标签： vba excel vbscript

【解决方案1】：

好吧，终于明白了.... 出于某种原因，如果我在 Excel 中拆分将工作簿保存到新宏的 VBA 代码部分，我将不再收到错误消息。

所以我最终得到了 3 个宏。 Lable1 上面的部分，然后是 Lable1 和另一个宏，它按照它们应该运行的顺序调用这两个宏。

另外对于错误处理，我错过了 Exit Sub 命令来阻止它在没有错误时执行。

感谢大家的帮助！

【讨论】：