ADO Select qry to access mdb
 

Hello ALL MVPS
Can Someone Please help The Handicap? That would be Me!
I have found this code and tried to modify but with no luck. It will work if
I need to see all records but I would like to do a Between TIME_STAMP to
limit data
I am running excel and access 2003. I have a mdb with all my query's in it.
This is so that My Managers don't get into access. And If i was any better in
Excel theres probably a way to query the whole thing in excel insted of in
access. I have a form that opens when workbook opens. On the form is a button
and 2 date pickers.
I would like to use these Startdate and EndDate for the Paramater Can anyone
PLEASE HELP OR LET ME KNOW WHERE IM GOING WRONG OR THAT THIS CANT BE DONE

Thank anyone who has taken the time to read.

'Connect to .mdb
Const stCon As String = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\Ilsa\Data\ReportBuilder.mdb;" & _
"Persist Security Info=False"



Private Sub cmdQuery_Click()
Application.ScreenUpdating = False

'run query to find records
Dim stParam As String, stParam2 As String
Dim stSQL As String
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Dim fld As ADODB.Field
Dim wsSheet As Worksheet, wbBook As Workbook
Dim i As Long, j As Long, x As Integer

'initial SQL
stSQL = "SELECT
TIME_STAMP,PLU_NUM,PLU_DESC,QTY,LAST_PRICE,Expr1,S TORE_NAME FROM
BreakdownsTest "

'set the parameter strings
stParam = ""
stParam2 = "Between TIMP_STAMP = fmSQL.StartDate AND TIME_STAMP <=
fmSQL.EndDate"






'check & build variable parameters
'depending on whether checkbox ticked by user
If Me.chkYr.Value = True Then
stSQL = stSQL & stParam & stParam2
Else: stSQL = stSQL & stParam2
End If

On Error GoTo ErrHandle

Set cnt = New ADODB.Connection
Set rst = New ADODB.Recordset

Set wbBook = ThisWorkbook
Set wsSheet = ThisWorkbook.Worksheets(1)

With cnt
.ConnectionString = stCon
.Open
End With

With rst
.CursorLocation = adUseClient
.Open stSQL, cnt, adOpenStatic, adLockReadOnly
.ActiveConnection = Nothing 'Here we disconnect the recordset.
j = .Fields.Count
i = .RecordCount
End With

With wsSheet
.UsedRange.Clear
If i = 0 Then GoTo i_Err
'Write the fieldnames to the fifth row in the worksheet
For x = 0 To j - 1
.Cells(5, x + 1).Value = rst.Fields(x).Name
Next x
'Dump the data to the worksheet.
.Cells(6, 1).CopyFromRecordset rst
End With

If CBool(rst.State And adStateOpen) = True Then rst.Close
Set rst = Nothing
If CBool(cnt.State And adStateOpen) = True Then cnt.Close
Set cnt = Nothing

FormatSheet
ExitHe
Exit Sub

ErrHandle:
Dim cnErrors As ADODB.Errors
Dim ErrorItem As ADODB.Error
Dim stError As String

Set cnErrors = cnt.Errors

With Err
stError = stError & vbCrLf & "VBA Error # : " & CStr(.Number)
stError = stError & vbCrLf & "Generated by : " & .Source
stError = stError & vbCrLf & "Description : " & .Description
End With

For Each ErrorItem In cnErrors
With ErrorItem
stError = stError & vbCrLf & "ADO error # : " & CStr(.Number)
stError = stError & vbCrLf & "Description : " & .Description
stError = stError & vbCrLf & "Source : " & .Source
stError = stError & vbCrLf & "SQL State : " & .SqlState
End With

Next ErrorItem
MsgBox stError, vbCritical, "SystemError"
Resume ExitHere

i_Err:
MsgBox "There are no records for this Query"
GoTo ExitHere

End Sub