M
Mike
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,STORE_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
ExitHere:
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
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,STORE_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
ExitHere:
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