此代码完美运行,直到我尝试添加错误处理(当VBA中的webquery没有撤回任何数据时)。现在它仍然运行,但我收到以下错误:
electron-prebuilt
这是我的VBScript,基本上只是在.xlsm工作簿中调用我的VBA
Script: C:\Test\test.vbs
Line: 8
Char: 1
Error: Cannot access 'Test.xlsm'.
Code: 800A9C68
Source: Microsoft Excel
以下是我刷新webquery的VBA代码,重新格式化一些小的格式错误,然后将工作表保存为当前目录中的.csv。
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
我试图做的错误处理是这样的:
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
答案 0 :(得分:1)
好吧,终于搞定了....出于某种原因,如果我将Excel中的VBA代码部分拆分为将工作簿保存到新宏,我就不会再收到错误了。
所以我最终得到了3个宏。 Lable1上面的部分,然后是Lable1,另一个宏按照它们应该运行的顺序调用这两个宏。
同样对于错误处理,我错过了Exit Sub命令,以便在没有错误时停止执行。
感谢您的帮助!