CODEWITHSUNDEEP
sql-servervbaexcel
pheeper
pheeper

Reputation: 1527

Settting .RefreshPeriod for an ADOBD SQL connection

I have an Excel spreadsheet that connects to SQL and pulls data from a table. I used the macro recorder and SQL import wizard to do this, however I now need to be able to write the data back to SQL so I came across this post and have been trying to make the below code work. It works fine, however I need to tweak it so it refreshes the data every minute so users are seeing data in near real time.

In the macro I recorded I was able to set a .RefreshPeriod = 1 parameter so the data would update, how can I do that here?

(Note: there are other functions dependent on the variables in here so I need to keep it somewhat the same - here is write up with full code). 

' General variables we'll need
Public con As ADODB.Connection
Public bIgnoreChange As Boolean
Dim pk As New Collection
Dim oldValue As Variant
Dim nRecordCount As Integer

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

    ' Let's retrieve the data from the SQL Server table with the same name as the sheet
    bIgnoreChange = True
    Set con = New ADODB.Connection
    con.Provider = "sqloledb"
    sConnectionString = "Server=CONDO-HTPC;Database=Strat_sample;Trusted_Connection=yes;" ';UID="";Pwd="" "
    con.Open sConnectionString


    ' Clean up old Primary Key
    While (pk.Count > 0)
        pk.Remove 1
    Wend

    ' Try to retrieve the primary key information
    On Error GoTo NoCon
    Set rs = con.Execute("SELECT COLUMN_NAME FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS AS tc INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE AS kcu ON tc.CONSTRAINT_NAME = kcu.CONSTRAINT_NAME WHERE tc.CONSTRAINT_TYPE = 'PRIMARY KEY' AND tc.TABLE_NAME = '" & Sh.name & "'")


'Disable eventchange trigger in Workbook_SheetChange sub while this runs
Application.EnableEvents = False

    ' Fill up the primary key infomration
    While (Not rs.EOF)
        pk.Add CStr(rs(0))
        rs.MoveNext
    Wend

    ' Clean up the sheet's contents
    Sh.UsedRange.Clear

    ' Now get the table's data
    Set rs = con.Execute("SELECT * FROM " & Sh.name)


    ' Set the name of the fields
    Dim TheCells As Range
    Set TheCells = Sh.Range("A1")
    For i = 0 To rs.Fields.Count - 1
        TheCells.Offset(0, i).Value = rs.Fields(i).name
    Next i

    ' Get value for each field
    nRow = 1
    While (Not rs.EOF)
        For i = 0 To rs.Fields.Count - 1
            TheCells.Offset(nRow, i).Value = rs(i)
        Next
        rs.MoveNext
        nRow = nRow + 1
    Wend
    nRecordCount = nRow - 1

    bIgnoreChange = (pk.Count = 0) And (nRecordCount > 0)




'Enable Workbook_SheetChange sub
Application.EnableEvents = True


    Exit Sub


NoCon:
    con.Close
    Set con = Nothing
    'Enable Workbook_SheetChange sub
    Application.EnableEvents = True
End Sub

Upvotes: 0

Views: 206

Answers (1)

Joshua Dannemann
Joshua Dannemann

Reputation: 2080

This is easy to do. As described in the answer for following Stackoverflow question, you can set a macro to run at intervals using Application.OnTime. After the macro runs, you set another wait period so it runs again.

VBA Macro On Timer style to run code every set number of seconds, i.e. 120 seconds

Also, make sure to turn off screen updating while the data is being refreshed.

Application.ScreenUpdating = False

Last, you should still be able to run this query if you set it up as a query table using the connection string. Then you just set the refresh rate and call it a day.

Upvotes: 1

Related Questions