VBA 错误处理不工作

Question

我正在编写一个 vba 程序，以根据用户说要通过带有复选框的表单刷新哪些报告来刷新许多报告的电源查询。

这部分代码刷新电源查询，如果刷新不成功，我希望它捕获错误。如果它没有更新，它将更新控制表“未更新”，然后我希望它接下来恢复。

由于某种原因，“On Error Goto Error”没有触发错误行。它仍然抛出错误并停止代码运行。

任何帮助将不胜感激！

For Each cell In 
wsConfig.ListObjects("tblReportstoRun").ListColumns(2).DataBodyRange
    If cell.Value = True Then
        cell.Offset(, 1).Value = Now()
        cell.Offset(, 2).Value = frmSetting.tbStartDate
        cell.Offset(, 3).Value = frmSetting.tbEnddate

        strCurrWS = cell.Offset(0, -1)
        ThisWorkbook.Sheets(strCurrWS).Activate
        Application.StatusBar = "Updating tab " & strCurrWS

            For Each qt In ThisWorkbook.Sheets(strCurrWS).QueryTables
                qt.Refresh BackgroundQuery:=False
            Next qt

            For Each lo In ThisWorkbook.Sheets(strCurrWS).ListObjects
                On Error GoTo Error
                lo.QueryTable.Refresh BackgroundQuery:=False
            Next lo
    Else
 Error:
    cell.Offset(, 4).Value = "Not Updated"
    If InStr(Err.Description, "Permission Error") Then
    cell.Offset(, 6).Value = "Permission Error. Check Credentials"
    Err.Clear
    End If


    End If
Next cell

Set qt = Nothing
Set wks = Nothing

Answer 1

我认为您希望避免将错误处理作为正常流程的一部分。我不确定您想要的逻辑，但如果您想在 For Each lo... 循环中恢复，请将 Resume Top 替换为 Resume Next

Sub a()

    For Each cell In wsConfig.ListObjects("tblReportstoRun").ListColumns(2).DataBodyRange
Top:

        If cell.Value = True Then
            cell.Offset(, 1).Value = Now()
            cell.Offset(, 2).Value = frmSetting.tbStartDate
            cell.Offset(, 3).Value = frmSetting.tbEnddate

            strCurrWS = cell.Offset(0, -1)
            ThisWorkbook.Sheets(strCurrWS).Activate
            Application.StatusBar = "Updating tab " & strCurrWS

                For Each qt In ThisWorkbook.Sheets(strCurrWS).QueryTables
                    qt.Refresh BackgroundQuery:=False
                Next qt

                For Each lo In ThisWorkbook.Sheets(strCurrWS).ListObjects
                    On Error GoTo ErrorCatch
                    lo.QueryTable.Refresh BackgroundQuery:=False
                Next lo
        Else
            cell.Offset(, 4).Value = "Not Updated"
        End If
    Next cell

    Set qt = Nothing
    Set wks = Nothing
    Exit Sub
ErrorCatch:
    cell.Offset(, 4).Value = "Not Updated"
    If InStr(Err.Description, "Permission Error") Then
        cell.Offset(, 6).Value = "Permission Error. Check Credentials"
    End If
    Resume Top
End Sub

Answer 2

您应该将Errorhandler 作为代码的结尾，并且永远不要将处理程序命名为“Error”

试试……

For Each cell In 
wsConfig.ListObjects("tblReportstoRun").ListColumns(2).DataBodyRange
    If cell.Value = True Then
        cell.Offset(, 1).Value = Now()
        cell.Offset(, 2).Value = frmSetting.tbStartDate
        cell.Offset(, 3).Value = frmSetting.tbEnddate

        strCurrWS = cell.Offset(0, -1)
        ThisWorkbook.Sheets(strCurrWS).Activate
        Application.StatusBar = "Updating tab " & strCurrWS

            For Each qt In ThisWorkbook.Sheets(strCurrWS).QueryTables
                qt.Refresh BackgroundQuery:=False
            Next qt

            For Each lo In ThisWorkbook.Sheets(strCurrWS).ListObjects
                On Error GoTo Errorhandle
                lo.QueryTable.Refresh BackgroundQuery:=False
            Next lo
Next cell

Set qt = Nothing
Set wks = Nothing

Exit Sub

Errorhandle:
    cell.Offset(, 4).Value = "Not Updated"
    If InStr(Err.Description, "Permission Error") Then
        cell.Offset(, 6).Value = "Permission Error. Check Credentials"
        Err.Clear
    End If