Refresh Excel Sheet with Access Data Frequently
 

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. Thank you 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(Arra y( _
"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