VBA 错误处理不工作

Question

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

这部分代码刷新电源查询，如果刷新不成功，我希望它捕获错误。如果未更新，它将更新控件 table "Not Updated"，然后我希望它在接下来恢复。

出于某种原因，"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

您应该将 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

Answer 2

我认为您想避免将错误处理作为正常流程的一部分。我不确定你想要的逻辑，但如果你想在 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

VBA 错误处理不工作

VBA Error Handling Not working

error-handling

excel

vba

powerquery