이 코드는 오류 처리를 추가하려고 할 때까지 완벽하게 작동했습니다 (VBA의 웹 쿼리가 데이터를 가져 오지 않은 경우). 이제 여전히 실행되지만 다음 오류가 발생합니다.
Script: C:\Test\test.vbs
Line: 8
Char: 1
Error: Cannot access 'Test.xlsm'.
Code: 800A9C68
Source: Microsoft Excel
이것은 본질적으로 .xlsm 통합 문서 내에서 내 VBA를 호출하는 내 VBScript입니다.
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
다음은 웹 쿼리를 새로 고치고 몇 가지 작은 서식 오류의 서식을 다시 지정한 다음 시트를 현재 디렉터리에 .csv로 저장하는 VBA 코드입니다.
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
좋아, 마침내 그것을 얻었습니다 .... 어떤 이유로 통합 문서를 새 매크로로 저장하는 Excel에서 VBA 코드 부분을 분할하면 더 이상 오류가 발생하지 않습니다.
그래서 저는 3 개의 매크로로 끝났습니다. Lable1 위의 부분, Lable1 및 실행될 순서대로 두 매크로를 모두 호출하는 다른 매크로.
또한 오류 처리를 위해 오류가 없을 때 실행을 중지하는 Exit Sub 명령이 누락되었습니다.
모든 도움에 감사드립니다!
이 기사는 인터넷에서 수집됩니다. 재 인쇄 할 때 출처를 알려주십시오.
침해가 발생한 경우 연락 주시기 바랍니다[email protected] 삭제
몇 마디 만하겠습니다