Hello,

I am trying to export a query, which contains parameters, to an excel template. I have tried creating an input box, saving the input in a variable, and naming the query parameter the variable name and I've tried referencing a form field name where I can enter a date and the query would pull up the form input date. I continue to get the "too few parameters" error.

Everything works fine when I use normal queries, I just don't know how to handle the parameters.

Has anyone done this before that can help me?

Thanks!:)

How are you trying to perform the export?

I'd use an ADO command object to create a recordset based on your parameter, then use Excel automation to write the recordset values out to an Excel worksheet with your template attached:

Option Compare Database

Private m_xls As Excel.Application

Sub Test()
    Dim rst As ADODB.Recordset
    Dim blnResult As Boolean

    ' Hard-coded input parameter (ProductID = 1). Could
    ' be a variable pulling a value from a form control.
    Set rst = GetProdScalarRecordset(1)

    ' Pass recordset to Excel export routine.
    blnResult = ExportToTemplate(rst, 2, 1, m_xls, "C:\Temp\Template1.xlt")

End Sub

' Routine that creates and returns a parameterized recordset
Public Function GetProdScalarRecordset(intProductID As Integer) As ADODB.Recordset

    Dim cnn As New ADODB.Connection
    Dim cmd As New ADODB.Command
    Dim rst As ADODB.Recordset
    Dim paramProductID As ADODB.Parameter

    ' The parameter queries name is "procProductScalar".
    ' Its SQL is:
    ' PARAMETERS inProductID Long;
    ' SELECT *
    ' FROM Products
    ' WHERE (((Products.ProductID)=[inProductID]));

    cmd.CommandText = "EXECUTE procProductScalar"
    cmd.CommandType = adCmdText

    Set cnn = GetNewConnection

    Set paramProductID = cmd.CreateParameter("inProductID", adInteger, adParamInput)
    cmd.Parameters.Append paramProductID
    paramProductID.Value = intProductID

    cmd.ActiveConnection = cnn
    Set rst = cmd.Execute

    ' Disconnect recordset and return
    rst.ActiveConnection = Nothing
    Set GetProdScalarRecordset = rst

    cnn.Close
    Set cnn = Nothing
    Set cmd = Nothing
    Exit Function

ErrHandler:

    If cnn.State = adStateOpen Then
        cnn.Close
    End If

    Set cnn = Nothing
    Set cmd = Nothing

    If Err <> 0 Then
        MsgBox Err.Source & "-->" & Err.Description, , "Error"
    End If

End Function

Public Function GetNewConnection() As ADODB.Connection
    Dim cnn As ADODB.Connection
    Dim strConnectString As String

    Set cnn = New ADODB.Connection

    strConnectString = "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Northwind.mdb"

    ' Set cnn to use a client side cursor so the recordset
    ' can be disconnected and the connection closed.
    cnn.CursorLocation = adUseClient
    cnn.Open strConnectString

    If cnn.State = adStateOpen Then
        Set GetNewConnection = cnn
    End If

End Function

Public Function ExportToTemplate(rst As ADODB.Recordset, _
   intStartRow As Integer, _
   intStartCol As Integer, _
   objExcel As Object, _
   Optional strTemplate, _
   Optional strDataPage) As Boolean

    Dim xlsSheet As Excel.worksheet
    Dim intRow As Integer
    Dim i As Integer

    If rst.RecordCount = 0 Then
        Call MsgBox("No Data", vbOKOnly)
    Else
        If OpenExcel() Then

            If Not IsMissing(strTemplate) Then
                m_xls.Workbooks.Add strTemplate
            Else
                m_xls.Workbooks.Add
            End If

            If Not IsMissing(strDataPage) Then
                Set xlsSheet = m_xls.Worksheets(strDataPage)
            Else
                Set xlsSheet = m_xls.ActiveSheet
            End If

            ' Write out recordset values to Excel spreadsheet
            ' using Excel automation.
            With xlsSheet
                intRow = intStartRow
                Do Until rst.EOF
                    For i = intStartCol To _
                        (intStartCol + rst.Fields.Count - 1)
                        .Cells(intRow, i).Value = rst.Fields _
                        (i - intStartCol)
                    Next i
                    rst.MoveNext
                    intRow = intRow + 1
                Loop
            End With

            xlsSheet.Visible = True
            m_xls.Visible = True
            Set objExcel = m_xls
            ExportToTemplate = True
        End If
    End If

End Function

Function OpenExcel()

On Error Resume Next

    Set m_xls = GetObject(, "Excel.Application")
    If m_xls Is Nothing Then
        Set m_xls = New Excel.Application
    End If

    If m_xls Is Nothing Then
        MsgBox "Can't Create Excel Object"
        OpenExcel = False
    Else
        OpenExcel = True
    End If

    DoEvents

End Function

Bob,

Thanks for the help. I will try that. This is the code I'm using:

Private Sub ExporttoTemplateList_Click()
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim rst As Recordset
Dim iRow As Integer

'--- open the workbook
Set objXL = New Excel.Application
objXL.Visible = True
Set objWkb = objXL.Workbooks.Open("c:\Templates\template.xlt")

Set objSht = objWkb.Worksheets("sheet1")

iRow = 5

Set rst = CurrentDb.OpenRecordset("SELECT * FROM [Query]" & _
"order by field1, field2, field3")

rst.MoveFirst

Do While Not rst.EOF
   objSht.Cells(iRow, 1).Value = rst!field1
   objSht.Cells(iRow, 2).Value = rst!field2
   objSht.Cells(iRow, 3).Value = rst!field3

   rst.MoveNext
Loop

rst.Close

Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
rst.Close

MsgBox "The Excel Spreadsheet has been created."

End Sub

That's the working code (expect I changed names and locations, etc).

Thanks!
Laura :)

I can't seem to get your version of the code working. It throws errors when I try to run your database connection function. This may be because the database is located on a share and it is linked to another database across a network which requires a password. That's why I'd prefer using "Set rst = CurrentDb.OpenRecordset(select * from query)"

What if I do something like:

Dim parameter AS Date
parameter = inputbox("Enter Date","Enter Date")

Set rst = CurrentDb.OpenRecordset("SELECT * from table WHERE field=" & parameter & ")"

Manually write the query in the code instead of calling the query, then use a variable as the parameter.

Any other suggestions?


Thanks!

Sounds like a plan, though here's a couple of additional connection string configurations:


For .mdb on a network share:



For using user level-security involving a workgroup file:

For a password protected database:



Or simething like that. The connection to the linked database should already by established in the initial database.


- Bob