Search code examples
sqlexcelvbaoledb

OLEDB Connection has no refresh date


I need to programatically check the refresh date on a number of OLEDB data connections in Excel to SQL tables and views. They're all configured the same way and use the same connection string, and I'm checking them in VBA using:

Connections.OLEDBConnection.RefreshDate

However, a handful of those connections do no have a refresh date, and I don't mean that RefreshDate property returns a NULL, that property doesn't even exist. VBA throws and "application-defined or object-defined error," and when I check the connection properties, the "last refreshed" field is blank:

enter image description here

It's consistent for connections to those particular SQL tables and views, regardless of how I build the connection or how many times I refresh it. I'm stuck using OLEDB, and some of our machines have compatibility issues with Power Query. Does anyone know what would cause this or what I need to change, either in Excel or in SQL?


Solution

  • If the refreshDate is not filled, probably you are out of luck.

    As a workaround, you could keep track about the refresh by yourself. Starting point is the afterRefresh-Event of a table. For this you have to add the following code to the Workbook-Module (will not work with a regular module as the With Events need a class.

    Option Explicit
    Private WithEvents table As Excel.QueryTable
    
    Private Sub table_AfterRefresh(ByVal Success As Boolean)
        Debug.Print table.WorkbookConnection.name & " refreshed. (success: " & Success & ")"
        If Success Then
            Call trackRefreshDate(table.WorkbookConnection.name, Now)
        End If
    End Sub
    

    Now you just need a logic to save the refresh event. In my example, I save it as name on workbook level, of course you could also save it in a (hidden) sheet. Put this into a regular module:

    Sub trackRefreshDate(tableName As String)
    
        Dim nameObj As Name, nName As String
        Set nameObj = Nothing
        nName = "Refresh_" & tableName
        On Error Resume Next
        ' Check if name already exists
        Set nameObj = ThisWorkbook.Names(nName)
        On Error GoTo 0
        Dim v
        v = Format(Now, "dd.mm.yyyy hh:MM:ss")
        If nameObj Is Nothing Then
            ' No: Create new
            Call ThisWorkbook.Names.Add(nName, v)
        Else
            nameObj.Value = v
        End If
    End Sub
    
    Function getRefreshDate(tableName As String)
        Dim nName As String
        nName = "Refresh_" & tableName
        On Error Resume Next
        getRefreshDate = Replace(Mid(ThisWorkbook.Names(nName), 2), """", "")
        On Error GoTo 0        
    End Function