Refresh Excel Sheet with Access Data Frequently

[Ron]

Hello all, I'm attempting to refresh an Excel sheet with this code from an Access dB. Since in Excel you can't set the refresh to less then 1 minute I'm trying to do it with VBA. However the way I have it set up (below) Excel crashes after about 2 minutes. My end results would be to have Excel refresh every 10 seconds. Any and all suggestions greatly appreciated. Thankyou Ron

Public Declare Function SetTimer Lib "user32" ( _
ByVal HWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long

Public Declare Function KillTimer Lib "user32" ( _
ByVal HWnd As Long, _
ByVal nIDEvent As Long) As Long

Public TimerID As Long
Public TimerSeconds As Single
Sub StartAccessTimer()
TimerSeconds = 10 ' how often to "pop" the timer.
TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProcAccess)
End Sub

Sub EndAccessTimer()
On Error Resume Next
KillTimer 0&, TimerID
End Sub

Sub TimerProcAccess(ByVal HWnd As Long, ByVal uMsg As Long, _
ByVal nIDEvent As Long, ByVal dwTimer As Long)

RefreshAccess

End Sub

'Recorded this code
Sub RefreshAccess()
With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
"ODBC;DSN=MS Access Database;DBQ=C:\Documents and Settings\smithr\My Documents\db1.mdb;DefaultDir=C:\Documents and Settings\smithr\My" _
), Array( _
" Documents;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;")), _
Destination:=Range("A2"))
.CommandText = Array( _
"SELECT `No Customer`.ID, `No Customer`.Record, `No Customer`.`Dealer Number`, `No Customer`.`Dealer Name`, `No Customer`.Address1, `No Customer`.Address2, `No Customer`.City, `No Customer`.State, `No " _
, _
"Customer`.Zip, `No Customer`.VIN" & Chr(13) & "" & Chr(10) & "FROM`C:\Documents and Settings\smithr\My Documents\db1`.`No Customer` `No Customer`" _
)
.Name = "Query from MS Access Database"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With


End Sub