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
|