0
votes

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.

1
That code would only ever monitor the refresh of the last querytable you assigned to the class. You should be using separate class instances for each QT.Rory
@Rory can you explain how to do that with an example using the above code?sifar
Well, firstly, I'm curious that you say this used to work as you have provided it here, since I don't see how it could. Are you certain of that?Rory
@Rory sorry my bad! I know why this is happening. I was disabling the events by adding these line 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

1 Answers

0
votes

I was disabling the QTable_AfterRefresh event by calling these custom procedure lines in the Main procedure code which enables/disables Application events.

DisableUpdating "GetCSVFilenames"

and

EnableUpdating "GetCSVFilenames"

After i commented out the code, the event started firing properly!