Settting .RefreshPeriod for an ADOBD SQL connection - sql-server

Question

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

Answer 1

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.