Import Access records to excel (parameter is a called funct) v.20
I haven't had a lot of experience with ADO (just fumbling through it the last
few months), but are you trying to use a stored procedure that takes a
parameter?
The ADODB.Command object has a Parameters property that you set before opening
the record set. Here's some code that I use to retrieve stock quotes for a
particular date. The query is defined in the database, and it requires a
parameter (the date).
Function PricesForSpecifiedDate(DBName As String, TheDate As Date) As Variant
'uses parameter query stored in the database
Dim Cmd As ADODB.Command
Dim Param As ADODB.Parameter
Set Cmd = New ADODB.Command
Set Param = New ADODB.Parameter
With Cmd
.CommandText = "Prices_as_of"
.CommandType = adCmdStoredProc
Set Param = .CreateParameter("Target_Date", adDBDate, adParamInput)
Param.Value = TheDate
.Parameters.Append Param
End With
PricesForSpecifiedDate = GetAccessDataFromQuery(Cmd, DBName)
End Function
Function GetAccessDataFromQuery(Cmd As ADODB.Command, _
DBName As String) As Variant
Dim Cnxn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim v As Variant
ReDim v(0, 0)
Set Cnxn = OpenConnection(DBName)
Cmd.ActiveConnection = Cnxn
Set rs = New ADODB.Recordset
With rs
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open Cmd
If .RecordCount 0 Then
v = .GetRows
Else
v(0, 0) = "No Records"
End If
.Close
End With
Cnxn.Close
Set Cnxn = Nothing
GetAccessDataFromQuery = v
End Function 'GetAccessDataFromQuery
Function OpenConnection(dBaseName As String) As ADODB.Connection
Dim Cnxn As ADODB.Connection
Set Cnxn = New ADODB.Connection
With Cnxn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source = " & XLDocDir & dBaseName
.Open
End With
Set OpenConnection = Cnxn
Set Cnxn = Nothing
End Function
On Thu, 23 Sep 2004 12:09:05 -0700, "PSKelligan"
wrote:
Hi All,
I am trying to retrieve records from 2 queries in an Access 2003 database to
Excel. The first one works fine but the 2nd is a parameter query and the
parameter is answered by a stored function. It defines a reporting period
start date based on the system clock. The function works in both access and
excel but when the query is run in the follwing code it returns an error
state the function is "undefined. Can anyone tell me how to get the import
proceedure to see and use the parameter function. I can store the date
function in access or excel. Whichever is more efficient. My code is as
follows.
Public Sub ImportFMC_MC_Data()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim objField As ADODB.Field
Dim rsData1 As ADODB.Recordset
Dim rsData2 As ADODB.Recordset
Dim Param1 As ADODB.Parameter
Dim Cmd1 As ADODB.Command
Dim lOffset As Long
Dim szConnect As String
'Trap any error/exception
'On Error Resume Next
'Body of proceedure.
'Creates and Names 2 Worksheets in the active Workbook.
ActiveWorkbook.Sheets.Add Type:=xlWorksheet, Count:=2, after:=Sheets(1)
Sheets(2).Name = "FMC Data 4-8 Days"
Sheets(3).Name = "MC Status"
'Create the connection string.
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\ERDLogTrack\LogTracker\ERD Logistics
Tracker_be.mdb;"
'Create Command Object.
Set Cmd1 = New ADODB.Command
Cmd1.ActiveConnection = szConnect
'Create the 1st Recordset object and run the query.
Set rsData1 = New ADODB.Recordset
rsData1.Open "[qryFMC_Equipment]", szConnect, adOpenForwardOnly,
adLockReadOnly, adCmdTable
'Make sure we got records back.
If Not rsData1.EOF Then
'Add headers to the worksheet.
With Sheets(2).Range("A1")
For Each objField In rsData1.Fields
.Offset(0, lOffset).Value = objField.Name
lOffset = lOffset + 1
Next objField
.Resize(1, rsData1.Fields.Count).Font.Bold = True
End With
'Dump the contents of the recordset into the worksheet.
Sheets(2).Range("A2").CopyFromRecordset rsData1
'Fit the column widths to the data
Sheets(2).UsedRange.EntireColumn.AutoFit
Else
MsgBox "Error: No Records Returned From qryFMC_Equipment.",
vbCritical, "ERD GMB"
End If
'Close the 1st recordset
rsData1.Close
Set rsData1 = Nothing
'Create the 2nd Recordset object and run the query.
Set rsData2 = New ADODB.Recordset
rsData2.Open "[qryMC_Status]", szConnect, adOpenForwardOnly,
adLockReadOnly, adCmdTable
'Make sure we got records back.
If Not rsData2.EOF Then
'Add headers to the worksheet.
With Sheets(3).Range("A1")
For Each objField In rsData2.Fields
.Offset(0, lOffset).Value = objField.Name
lOffset = lOffset + 1
Next objField
.Resize(1, rsData2.Fields.Count).Font.Bold = True
End With
'Dump the contents of the recordset into the worksheet.
Sheets(3).Range("A2").CopyFromRecordset rsData2
'Fit the column widths to the data
Sheets(3).UsedRange.EntireColumn.AutoFit
Else
MsgBox "Error: No Records Returned From qryMC_Status.", vbCritical,
"ERD GMB"
End If
'Close the recordset
rsData2.Close
Set rsData2 = Nothing
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
|