VBA RefreshPeriod breaks AfterRefresh event

Question

After each refresh (every X minutes) of web query in Excel, I want to call a set of procedures. It is possible with .AfterRefresh event. However it gets triggered only once, the first time.

Problems:

.AfterRefresh event doesn't get triggered more than once (the first time) after setting .RefreshPeriod
Can't reference a query table by its name - Worksheet.QueryTables(qtName) - because Excel automatically adds suffix to the name, i.e. qtName becomes qtName_1

Possible solutions:

Using timer: Application.OnTime Now + TimeValue("00:01:00"), "InitializeWebQuery"
Checking if connection name connectionName exists in the workbook. If not, add query table and set its workbook connection name to connectionName for the next time check.

VBA code:

Create a module and a class, copy the code below. Every two minutes, it should display message after refreshing: "Refresh succeeded."

Query Module:

Option Explicit

' Query module    

Public Const webQueryUrl As String = "http://www.bbc.co.uk/sport/football/premier-league/table"
Public evt As Events

Public Sub InitializeWebQuery()
    Dim webQuerySheet As Worksheet
    Dim webQueryResults As QueryTable
    Dim queryTbl As QueryTable

    ' Get worksheet for web query
    On Error Resume Next
        Set webQuerySheet = ThisWorkbook.Sheets("webQuery")
    On Error GoTo 0

    ' If the worksheet doesn't exist, create it
    If webQuerySheet Is Nothing Then
        With ThisWorkbook
            Set webQuerySheet = .Sheets.Add(After:=.Sheets(.Sheets.Count))
            webQuerySheet.Name = "webQuery"
        End With
    End If

    ' Check if our connection exists; if not, add it
    If ConnectionExists("connectionBBC") = False Then
        ' Clear the worksheet completely to prepare it for receiving query results
        webQuerySheet.Cells.Clear

        ' Remove all query tables (removes also connection in `ThisWorkbook.Connections`)
        For Each queryTbl In webQuerySheet.QueryTables
            queryTbl.Delete
        Next queryTbl

        ' Add proper query table
        With webQuerySheet.QueryTables.Add( _
                Connection:="URL;" & webQueryUrl, _
                Destination:=webQuerySheet.Cells(1, 1) _
            )
            .Name = "queryBBC"
            ' Set `false` to catch `.AfterRefresh` event properly; other solutions: https://stackoverflow.com/a/18137027
            .BackgroundQuery = False
            ' Note: it starts counting the time right after `.Refresh`, doesn't wait until refreshing is finished
            .RefreshPeriod = 2
            .RefreshStyle = xlInsertDeleteCells
            .WebFormatting = xlWebFormattingAll
            .WebSelectionType = xlSpecifiedTables
            ' Select the first table on website, i.e. the Premier League table
            .WebTables = "1"
        End With

        ' Change connection name
        ThisWorkbook.Connections(webQuerySheet.QueryTables(1).WorkbookConnection.Name).Name = "connectionBBC"

        ' Choose query table by index, because XLS likes to add suffix `_1` to the query table name, e.g. `queryBBC_1`
        Set webQueryResults = webQuerySheet.QueryTables(1)
    Else
        Set webQueryResults = webQuerySheet.QueryTables(1)
    End If

    Set evt = New Events
    Set evt.HookedTable = webQueryResults

    With webQueryResults
        .Refresh
    End With

    ' Workaround.
    ' Set timer because `.RefreshPeriod` doesn't trigger `.AfterRefresh` event

    ' Application.OnTime Now + TimeValue("00:01:00"), "InitializeWebQuery"
End Sub

Private Function ConnectionExists(connectionName As String) As Boolean
    Dim conn As WorkbookConnection

    ConnectionExists = False

    For Each conn In ThisWorkbook.Connections
        If conn.Name = connectionName Then
            ConnectionExists = True
        End If
    Next conn
End Function

Events class:

Option Explicit

' Source: https://stackoverflow.com/a/26991520

Private WithEvents qt As QueryTable

Public Property Set HookedTable(q As QueryTable)
    Set qt = q
End Property

Public Property Get HookedTable() As QueryTable
    Set HookedTable = qt
End Property

Private Sub qt_AfterRefresh(ByVal Success As Boolean)
    If Success = True Then
        MsgBox "Successfully refreshed."
    End If
End Sub

Private Sub qt_BeforeRefresh(Cancel As Boolean)
    Dim answer As Integer

    answer = MsgBox("Refresh now?", vbYesNoCancel)

    If answer = vbNo Then
        Cancel = True
    End If
End Sub

Useful resources:

VBA RefreshPeriod breaks AfterRefresh event

0 Answers0