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

问题描述

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

类 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：查询名称和工作表名称是虚拟名称，彼此不同。

解决方法

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

DisableUpdating "GetCSVFilenames"

和

EnableUpdating "GetCSVFilenames"

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