ListObject的QueryTable_AfterRefresh.QueryTable在Excel 2016中不起作



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

类别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条件中添加了一个查询(。

附言:查询名称和工作表名称是伪名称,彼此不同

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

DisableUpdating "GetCSVFilenames"

EnableUpdating "GetCSVFilenames"

在我注释掉代码后,事件开始正常启动!

最新更新