excel - 为什么 Excel 会因自动化错误而崩溃？

Question

这是我的第一篇文章，所以如果我做错了，请不要钉死我。

我编写了这段代码，它打开了一系列工作簿（它打开的工作簿数量取决于该国家/地区的诊所数量，最多 200 个），然后将工作簿中的任何问题数据复制到宏中工作簿。然后它会获取它跟踪的所有问题，并将它们复制到另一个工作簿中，并将其保存为问题日志。当它运行时，在某个随机点，我得到一个完全崩溃的自动化错误。我不会在错误行上中断。我没有收到任何交互或其他警告，并且自动化错误没有错误代码，只有带有“确定”和“帮助”按钮的自动化错误。帮助按钮对我没有任何作用。我试过放入计时器让工作簿打开。我' 已尝试禁用打开工作簿时可能运行的宏以加快它们的速度。我尝试过单步执行，但这不会产生错误，所以只有在它全速运行时才会出现。

我已经读到这些错误是由 VBA 无法引用工作簿对象引起的，因为在调用与工作簿关联的对象时它还没有完全“打开”，因此添加了计时和宏终止代码，但无济于事。

有人可以告诉我我做错了什么吗？这是为了工作，我需要此报告才能正常运行。感谢任何愿意提前提供帮助的人。

这是从工作簿中提取问题的代码：

Public Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long

Sub GetIssues()

    Dim country As String, checkPer As String, CheckMon As String, fiscYear As String, fPath As String, openFile As String, openName As String, clerk As String
    Dim company As Integer, i As Integer, clinic As Integer, checkMonDays As Integer, last As Integer, b As Integer, tableRow As Integer
    Dim setupWS As Worksheet, checkWS As Worksheet, issueWS As Worksheet, valueWS As Worksheet, metaWS As Worksheet, ws As Worksheet
    Dim checkWB As Workbook
    Dim fso As New FileSystemObject
    Dim listObj As ListObject
    Dim issueWSfile As Range, valueWSfile As Range, checkWSRng As Range, checkWSRng2 As Range, dateRange As Range, cell As Range, tableRng As Range, tableRng2 As Range
    Dim startDate As Date, Timer As Date, StartTime As Date, EndTime As Date
    Dim NowTick As Long, EndTick As Long

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    'previousSecurity = Application.AutomationSecurity
    'Application.AutomationSecurity = msoAutomationSecurityForceDisable

    StartTime = TimeValue(Time)

    Set setupWS = ThisWorkbook.Sheets("Setup")
    Set metaWS = ThisWorkbook.Sheets("Meta Data")
    Set issueWS = ThisWorkbook.Sheets("Issues")
    Set valueWS = ThisWorkbook.Sheets("Values")
    Set dateRange = issueWS.Range("F1:AL1")

    last = metaWS.Cells(Rows.count, "B").End(xlUp).Row
    startDate = DateValue(setupWS.Range("F4").Value)

    Set issueWSfile = issueWS.Range("A2:A" & last)
    Set valueWSfile = valueWS.Range("A2:A" & last)

    issueWS.Range("A2:AK1000,F1:AJ1").ClearContents
    valueWS.Range("A2:AK1000,F1:AJ1").ClearContents
    dateRange.ClearContents

    fPath = Left(ThisWorkbook.Path, Len(ThisWorkbook.Path) - Len("Takings Control Recs"))

    checkPer = Trim(Right(GetIssForm.ComboBox2.Value, 3))
    fiscYear = Left(GetIssForm.ComboBox2.Value, 4)

    If checkPer = "P1" Then
        CheckMon = "Oct"
    ElseIf checkPer = "P2" Then
        CheckMon = "Nov"
    ElseIf checkPer = "P3" Then
        CheckMon = "Dec"
    ElseIf checkPer = "P4" Then
        CheckMon = "Jan"
    ElseIf checkPer = "P5" Then
        CheckMon = "Feb"
    ElseIf checkPer = "P6" Then
        CheckMon = "Mar"
    ElseIf checkPer = "P7" Then
        CheckMon = "Apr"
    ElseIf checkPer = "P8" Then
        CheckMon = "May"
    ElseIf checkPer = "P9" Then
        CheckMon = "Jun"
    ElseIf checkPer = "P10" Then
        CheckMon = "Jul"
    ElseIf checkPer = "P11" Then
        CheckMon = "Aug"
    ElseIf checkPer = "P12" Then
        CheckMon = "Sep"
    End If

    Application.Calculation = xlCalculationAutomatic
    setupWS.Range("F1").Value = checkPer
    Application.Calculation = xlCalculationManual

    If CheckMon = "Jan" Or CheckMon = "Mar" Or CheckMon = "May" Or CheckMon = "Jul" Or CheckMon = "Aug" Or CheckMon = "Oct" Or CheckMon = "Dec" Then
        checkMonDays = 31
    ElseIf CheckMon = "Apr" Or CheckMon = "Jun" Or CheckMon = "Sep" Or CheckMon = "Nov" Then
        checkMonDays = 30
    Else: checkMonDays = 28
    End If

    For b = 1 To checkMonDays
        issueWS.Cells(1, b + 5).Value = startDate
        valueWS.Cells(1, b + 5).Value = startDate
        startDate = startDate + 1
    Next b

    country = GetIssForm.ComboBox3.Value

    'Unload GetIssForm

    For i = 5 To last
        If metaWS.Range("H" & i).Value = country Then
            company = metaWS.Range("D" & i).Value
            clinic = metaWS.Range("B" & i).Value
            clerk = metaWS.Range("F" & i).Value
            openFile = fPath & country & "\" & fiscYear & "\" & checkPer & "\E " & company & "\" & clinic & " " & checkPer & " " & CheckMon & ".xlsb"
            If Dir(openFile) <> "" Then
                openName = fso.getfilename(openFile)
                Set checkWB = Workbooks.Open(openFile)
                'EndTick = GetTickCount + 500
                'Do
                 '   NowTick = GetTickCount
                  '  DoEvents
                'Loop Until NowTick > EndTick
                Set checkWS = checkWB.Sheets("Transaction Hub")
                Set checkWSRng = checkWS.Range("AX11:AX41")
                Set checkWSRng2 = checkWS.Range("AU11:AU41")
                issueWS.Range("A" & i - 3).Value = openFile
                issueWS.Range("B" & i - 3).Value = company
                issueWS.Range("C" & i - 3).Value = clinic
                issueWS.Range("D" & i - 3).Value = clerk
                issueWS.Range("E" & i - 3).Value = country
                valueWS.Range("A" & i - 3).Value = openFile
                valueWS.Range("B" & i - 3).Value = company
                valueWS.Range("C" & i - 3).Value = clinic
                valueWS.Range("D" & i - 3).Value = clerk
                valueWS.Range("E" & i - 3).Value = country
                checkWSRng.Copy
                issueWS.Range("F" & i - 3).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, , True
                checkWSRng2.Copy
                valueWS.Range("F" & i - 3).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, , True
                Application.CutCopyMode = False
                Workbooks(openName).Close False
                Set checkWB = Nothing
            Else: End If
        End If
    Next i

    last = issueWS.Cells(Rows.count, "A").End(xlUp).Row

    Set listObj = issueWS.ListObjects(1)

    listObj.Resize Range("A1:AJ" & last)

    Set listObj = valueWS.ListObjects(1)

    listObj.Resize Range("A1:AJ" & last)

    Set tableRng = issueWS.ListObjects("Table2").Range
    Set tableRng2 = valueWS.ListObjects("Table1").Range

    issueWS.Activate

    For tableRow = tableRng.Row + tableRng.Rows.count - 1 To tableRng.Row Step -1
        If Application.WorksheetFunction.CountA(Rows(tableRow)) = 0 Then Rows(tableRow).EntireRow.Delete
    Next

    valueWS.Activate

    For tableRow = tableRng2.Row + tableRng2.Rows.count - 1 To tableRng2.Row Step -1
        If Application.WorksheetFunction.CountA(Rows(tableRow)) = 0 Then Rows(tableRow).EntireRow.Delete
    Next

    For Each ws In ThisWorkbook.Worksheets
        ws.Activate
        ActiveWindow.ScrollRow = 1
        ActiveWindow.ScrollColumn = 1
        Range("A1").Select
    Next ws

    ThisWorkbook.Sheets("Run").Activate

    issueWS.Range("B:D").EntireColumn.AutoFit
    valueWS.Range("B:D").EntireColumn.AutoFit

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    'Application.AutomationSecurity = previousSecurity

    EndTime = TimeValue(Time)

    Timer = Format(EndTime - StartTime, "hh:mm:ss")

    'MsgBox "Finished in " & -Timer & " seconds", vbOKOnly, "Workbooks Created -"

    Call ReportIssues

End Sub```

And here's the code that creates the issue log:

```Option Explicit

Sub ReportIssues()

    Dim ARow As Long, issuesLastRow As Long, ACol As Long, issuesLastCol As Long, IRow As Long, issuesLastRow2 As Long, issuesLastCol2 As Long
    Dim DateNum As String, Month As String, Year As String, country As String, TestStr As String, answer As String, fPath As String
    Dim issuesWB As Workbook
    Dim ws As Worksheet, issuesWS As Worksheet, valuesWS As Worksheet, dataWS As Worksheet, setupWS As Worksheet
    Dim count As Integer

    Application.EnableEvents = False
    Application.DisplayAlerts = False

    Set dataWS = ThisWorkbook.Sheets("Issues")
    Set setupWS = ThisWorkbook.Sheets("Setup")
    Set valuesWS = ThisWorkbook.Sheets("Values")

    dataWS.Activate

    fPath = ThisWorkbook.Path & "\Issue Logs\"
    Debug.Print fPath
    issuesLastRow = dataWS.Cells(Rows.count, "B").End(xlUp).Row
    issuesLastCol = dataWS.Cells(1, Columns.count).End(xlToLeft).Column
    issuesLastRow2 = valuesWS.Cells(Rows.count, "B").End(xlUp).Row
    issuesLastCol2 = valuesWS.Cells(1, Columns.count).End(xlToLeft).Column
    IRow = 3
    DateNum = Replace(setupWS.Range("D2"), "/", "")
    count = 0
    Application.ScreenUpdating = False

    country = GetIssForm.ComboBox3.Value

    Unload GetIssForm

    Set issuesWB = Workbooks.Open("Z:\Finance\HO European Transformation\15.SSC\Q Track\Build\Issues Sheet Temp.xlsb")
    Set issuesWS = issuesWB.Sheets("Issues")

    dataWS.ListObjects("Table2").Range.AutoFilter Field:=5, Criteria1:=country

    valuesWS.ListObjects("Table1").Range.AutoFilter Field:=5, Criteria1:=country

    If Dir(fPath & country & " " & DateNum & ".xlsb") = "" Then
here:
        For ACol = 6 To issuesLastCol
            For ARow = 2 To issuesLastRow
                If Not IsError(dataWS.Cells(ARow, ACol)) And dataWS.Cells(ARow, ACol) <> 0 And dataWS.Cells(ARow, ACol) <> "" And Len(dataWS.Cells(ARow, ACol)) > 5 And dataWS.Cells(ARow, 5) = country Then 'And dataWS.Cells(1, ACol) < setupWS.Range("D2") Then 'And dataWS.Cells(1, ACol) > setupWS.Range("F4") - 1 Then
                    issuesWS.Cells(IRow, 1) = dataWS.Cells(1, ACol)
                    issuesWS.Cells(IRow, 2) = dataWS.Cells(ARow, 5)
                    issuesWS.Cells(IRow, 3) = dataWS.Cells(ARow, 3)
                    issuesWS.Cells(IRow, 4) = dataWS.Cells(ARow, 2)
                    issuesWS.Cells(IRow, 5) = dataWS.Cells(ARow, ACol)
                    issuesWS.Cells(IRow, 6) = valuesWS.Cells(ARow, ACol)
                    IRow = IRow + 1
                    count = count + 1
                End If
            Next ARow
            ARow = 2
        Next ACol
        If count = 0 Then
        For ACol = 6 To issuesLastCol2
            For ARow = 2 To issuesLastRow2
                If Not IsError(valuesWS.Cells(ARow, ACol)) And valuesWS.Cells(ARow, ACol) <> 0 And valuesWS.Cells(ARow, ACol) <> "" And valuesWS.Cells(ARow, 5) = country Then 'And dataWS.Cells(1, ACol) < setupWS.Range("D2") Then 'And dataWS.Cells(1, ACol) > setupWS.Range("F4") - 1 Then
                    issuesWS.Cells(IRow, 1) = dataWS.Cells(1, ACol)
                    issuesWS.Cells(IRow, 2) = dataWS.Cells(ARow, 5)
                    issuesWS.Cells(IRow, 3) = dataWS.Cells(ARow, 3)
                    issuesWS.Cells(IRow, 4) = dataWS.Cells(ARow, 2)
                    issuesWS.Cells(IRow, 5) = dataWS.Cells(ARow, ACol)
                    issuesWS.Cells(IRow, 6) = valuesWS.Cells(ARow, ACol)
                    IRow = IRow + 1
                    count = count + 1
                End If
            Next ARow
            ARow = 2
        Next ACol
        End If
        With issuesWB
            .SaveAs fPath & country & " " & DateNum & ".xlsb"
            .Activate
            .Close False
        End With
        MsgBox country & " Issue Sheet saved to Issue Log folder.", vbOKOnly, "File Saved -"
    ElseIf Dir(fPath & country & " " & DateNum & ".xlsb") <> "" Then
        answer = MsgBox("Do you wish to overwrite the previous Issue Report file for " & country & "?", vbYesNo, "Existing File -")
        If answer = vbYes Then
            GoTo here:
        ElseIf answer = vbNo Then
            issuesWB.Close False
        End If
    End If

    For Each ws In ThisWorkbook.Worksheets
        ws.Activate
        ActiveWindow.ScrollRow = 1
        ActiveWindow.ScrollColumn = 1
        Range("A1").Select
    Next ws

    ThisWorkbook.Sheets("Run").Activate

    'Unload RepIssForm

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True

End Sub```

标签： excelvbaerror-handlingautomation