ListObject.Querytable 的 QueryTable_AfterRefresh 在 Excel 2016 中不起作用

Posted 2023-02-19

【中文标题】ListObject.Querytable 的 QueryTable_AfterRefresh 在 Excel 2016 中不起作用

【英文标题】：QueryTable_AfterRefresh of a ListObject.Querytable not working in Excel 2016

【发布时间】：2021-03-31 03:05:31

【问题描述】：

我正在提取一组 csv 文件作为 poweryQuery 表，我在 Excel 2016 Pro 工作簿中以特定顺序运行。我在 QueryTable After_Refresh 事件中调用了一个外部过程 AddOutcomeColumn，以向某些 ListObject QueryTables 添加一个额外的列。 2天前它可以工作，但现在无法正常工作。代码保持不变。

类 clsQR 码：

Option Explicit

Private WithEvents QTable As Excel.QueryTable
Private pMsg As String
Private colCollection As New Collection

Public Property Let Message(msg As String)
    pMsg = msg
End Property

Public Property Get Message() As String
    Message = pMsg
End Property

Public Sub Init(ByRef QT As Excel.QueryTable)
    Set QTable = QT
    With QTable
        .Refresh False
    End With
    colCollection.Add Item:=QTable, Key:=pMsg
End Sub

Private Sub QTable_BeforeRefresh(Cancel As Boolean)
    Application.StatusBar = "Refreshing Query... " & pMsg
End Sub

Private Sub QTable_AfterRefresh(ByVal Success As Boolean)
    Application.StatusBar = "Refreshed Query... " & pMsg
    If QTable.ListObject.Name = "jkl" Then
        AddOutcomeColumn QTable
    End If
End Sub

模块主代码：

Option Explicit

Dim clsQ As clsQR
Dim QT As QueryTable

Sub GetCSVFilenames()

Dim oFD As FileDialog
Dim oFile As Object, oFiles As Object, oFolder As Object
Dim sPath As String

On Error GoTo ErrorHandler
' DisableUpdating "GetCSVFilenames"
Set clsQ = New clsQR

Set oFD = Application.FileDialog(msoFileDialogFolderPicker)
With oFD
    .Title = "Select CSV folder"
    .InitialFileName = Environ("USERPROFILE") & "\Desktop"
    
    If oFD.Show = -1 Then
        With ThisWorkbook.Sheets("AAA")
            .Cells(4, "F") = oFD.SelectedItems(1)
            
            Set QT = .ListObjects("abc").QueryTable
            clsQ.Message = "abc"
            clsQ.Init QT:=QT
        End With
        
        With ThisWorkbook.Sheets("BBB")
            Set QT = .ListObjects("def").QueryTable
            clsQ.Message = "def"
            clsQ.Init QT:=QT
        
            Set QT = .ListObjects("ghi").QueryTable
            clsQ.Message = "ghi"
            clsQ.Init QT:=QT
        End With
        
        With ThisWorkbook.Sheets("CCC")
            Set QT = .ListObjects("jkl").QueryTable
            clsQ.Message = "jkl"
            clsQ.Init QT:=QT
            If ThisWorkbook.Sheets("CCC").Visible = xlSheetHidden Then ThisWorkbook.Sheets("CCC").Visible = True
        End With
        
        With ThisWorkbook.Sheets("DDD")
            Set QT = .ListObjects("mno").QueryTable
            clsQ.Message = "mno"
            clsQ.Init QT:=QT
            If ThisWorkbook.Sheets("DDD").Visible = xlSheetHidden Then ThisWorkbook.Sheets("DDD").Visible = True
        End With
        
        With ThisWorkbook.Sheets("EEE")
            Set QT = .ListObjects("pqr").QueryTable
            clsQ.Message = "pqr"
            clsQ.Init QT:=QT
            If ThisWorkbook.Sheets("EEE").Visible = xlSheetHidden Then ThisWorkbook.Sheets("EEE").Visible = True
        End With
        
        With ThisWorkbook.Sheets("FFF")
            Set QT = .ListObjects("stu").QueryTable
            clsQ.Message = "stu"
            clsQ.Init QT:=QT
            If ThisWorkbook.Sheets("FFF").Visible = xlSheetHidden Then ThisWorkbook.Sheets("FFF").Visible = True
        End With
        
        With ThisWorkbook.Sheets("GGG")
            Set QT = .ListObjects("vwx").QueryTable
            clsQ.Message = "vwx"
            clsQ.Init QT:=QT
            If ThisWorkbook.Sheets("GGG").Visible = xlSheetHidden Then ThisWorkbook.Sheets("GGG").Visible = True
        End With
    End If
End With
Application.StatusBar = ""

ExitSub:
'    EnableUpdating "GetCSVFilenames"
    Exit Sub
    
ErrorHandler:
    MsgBox "Error#: " & Err.Number & vbCrLf & "Description: " & Err.Description, vbCritical + vbOKOnly, "An Error occurred!"
    Err.Clear
    On Error GoTo 0
    Resume ExitSub

End Sub

这是因为这些是Listobject Querytables 而不是纯 Excel 查询表，其事件可能不再存在？或者 Excel 2016 有什么变化？我无法在刷新一个或多个查询后运行AddOutcomeColumn 过程（例如，我刚刚在类的 if 条件中添加了 1 个查询）。

P.S：查询名称和工作表名称是虚拟名称，彼此不同。

【问题讨论】：

该代码只会监视您分配给该类的 last 查询表的刷新。您应该为每个 QT 使用单独的类实例。

@Rory 你能用上面的代码举例说明如何做到这一点吗？

嗯，首先，我很好奇你说这个 used 像你在这里提供的那样工作，因为我不明白它是怎么做到的。你确定吗？

@Rory 对不起我的错！我知道为什么会这样。我通过添加这些行 DisableUpdating "GetCSVFilenames" 禁用事件，然后稍后启用它。这是禁止触发 Query_AfterRefresh() 事件。现在注释掉这些行后它可以正常工作了。

【参考方案1】：

我通过在启用/禁用Application events 的Main procedure 代码中调用这些自定义过程行来禁用QTable_AfterRefresh 事件。

DisableUpdating "GetCSVFilenames"

和

EnableUpdating "GetCSVFilenames"

在我注释掉代码后，事件开始正常触发！