I am pulling a set of csv files as poweryQuery tables that i am running in a particular sequence in an Excel 2016 Pro workbook. I am calling an external procedure AddOutcomeColumn
in the QueryTable After_Refresh
event to add an extra column to some of the ListObject QueryTables. It was working 2 days ago, but now not working. The code remains unchanged.
Class clsQR code:
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
Module Main code:
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
Is this due to the fact that these are Listobject Querytables
and not pure Excel Querytables, for which the Events may no longer exist? Or has something changed in Excel 2016? I am not able to run the AddOutcomeColumn
procedure post refreshing one or more of the queries (as an example i have just added 1 query in the if condition in the Class).
P.S: The query names and worksheet names are dummy names and different from each other.
DisableUpdating "GetCSVFilenames"
and then enabling it later. This was disabling the Query_AfterRefresh() event from firing. Now it is working correctly after commenting out those lines. – sifar