Exporting query to Excel. Almost there

[Wombat]

I have a query based on a combobox that works fine, and a function that I 'borrowed' from a message board that exports a query to Excel. That also works fine except when I use it with a query that is based on a combobox.



I get an error that says "Error 3061 too Few Parameters. Expected 1."

Here is my query:

Code:

SELECT tblItem.Pallet, tblItem.PO, tblItem.Dept, tblItem.Class, tblItem.ItemNumber, tblItem.VesselVoyage, tblItem.Container, tblItem.Cartons, tblItem.UnitsPerCarton, tblItem.EA, tblItem.ItemDescription, tblItem.DamageDescriptionFROM tblItemWHERE (((tblItem.SalvagePickupName)=[Forms]![frmMain]![cboSalvagePickup]));
And here is my code:

Code:

Private Sub btnSalvageReport_Click() Call SalvageToExcel("qrySalvageReport", "Sheet1", "J:\MyFolder\qrySalvageReport.xlsx")End Sub
Which calls this function:

Code:

Public Function SalvageToExcel(strTQName As String, strSheetName As String, strFilePath As String)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to
' strFilePath is the name and path of the file you want to send this data into.
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.Field
    Dim strPath As String
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    On Error GoTo err_handler
    strPath = strFilePath
    Set rst = CurrentDb.OpenRecordset(strTQName)
    Set ApXL = CreateObject("Excel.Application")
    Set xlWBk = ApXL.Workbooks.Open(strPath)
    ApXL.Visible = True
    Set xlWSh = xlWBk.Worksheets(strSheetName)
    xlWSh.Range("A1").Select
    For Each fld In rst.Fields
        ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next
    rst.MoveFirst
    xlWSh.Range("A2").CopyFromRecordset rst
    xlWSh.Range("A1:L1").Select
    With ApXL.Selection
        .Font.Name = "Arial"
        .Font.Size = 12
        .Borders.LineStyle = xlContinuous
        .Borders.ColorIndex = xlAutomatic
    End With
    With ApXL.Selection
        .Interior.Color = RGB(153, 204, 51)
        .HorizontalAlignment = xlCenter
        .RowHeight = 30
        .VerticalAlignment = xlCenter
    End With
    ApXL.ActiveSheet.Cells.Select
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
    ApXL.ActiveSheet.Cells.HorizontalAlignment = xlCenter
    xlWSh.Range("A1").Select
    rst.Close
    Set rst = Nothing
Exit_SendSalvageToExcel:
    Exit Function
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_SendSalvageToExcel
End Function

Any ideas?

[pbaldy]

Your code is unreadable like that, but I suspect you're running into this:

http://support.microsoft.com/default...b;en-us;209203

Another solution is to wrap the form reference in the query in the Eval() function.

[Wombat]

Sorry, fixed my code. I will check the link.

[Wombat]

thanks for your reply, this might help. I didn't think that I needed to feed it the parameter in code since it is written right into the query.

[pbaldy]

Sadly, yes. DAO can't resolve the form reference, hence the error.

[Wombat]

Sadly, it appears that I can't resolve the form reference either.

[pbaldy]

What's your code now, if you're using the method from the link?

[Wombat]

What's your code now, if you're using the method from the link?

I started first by trying to define the parameter before calling the function, but couldn't get that, so I decided to butcher the function instead. I got this far yesterday and gave up. I think that I can maybe get one thing working, but combining these two things (the export to excel with this new parameter part) has me over my head.

Right now it stops on the definition of "strTQName![Forms!frmMain!cboSalvagePickup]" and says "qualifier must be a collection"

Public Function SalvageToExcel(strTQName As String, strSheetName As String, strFilePath As String)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to
' strFilePath is the name and path of the file you want to send this data into.
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.Field
    Dim strPath As String
    Dim strSearchName As String
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    On Error GoTo err_handler
    strPath = strFilePath
    
    
    strSearchName = Forms![frmMain]![cboSalvagePickup]
    strTQName![Forms!frmMain!cboSalvagePickup] = strSearchName    <-------------------Qualifier must be a collection
    Set rst = CurrentDb.OpenRecordset(strTQName)
    Set ApXL = CreateObject("Excel.Application")
    Set xlWBk = ApXL.Workbooks.Open(strPath)
    ApXL.Visible = True
    Set xlWSh = xlWBk.Worksheets(strSheetName)
    xlWSh.Range("A1").Select
    For Each fld In rst.Fields
        ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next
    rst.MoveFirst
    xlWSh.Range("A2").CopyFromRecordset rst
    xlWSh.Range("A1:L1").Select
    With ApXL.Selection
        .Font.Name = "Arial"
        .Font.Size = 12
        .Borders.LineStyle = xlContinuous
        .Borders.ColorIndex = xlAutomatic
    End With
    With ApXL.Selection
        .Interior.Color = RGB(153, 204, 51)
        .HorizontalAlignment = xlCenter
        .RowHeight = 30
        .VerticalAlignment = xlCenter
    End With
    ApXL.ActiveSheet.Cells.Select
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
    ApXL.ActiveSheet.Cells.HorizontalAlignment = xlCenter
    xlWSh.Range("A1").Select
    rst.Close
    Set rst = Nothing
Exit_SendSalvageToExcel:
    Exit Function
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_SendSalvageToExcel
End Function

[pbaldy]

That link can be confusing. Here are the relevant lines:


Dim qdfMyQuery As DAO.QueryDef
Dim dbSample As DAO.Database
Dim rstCountOrders As DAO.Recordset
Dim strSearchName As String

Set dbSample = CurrentDb()
Set qdfMyQuery = dbSample.QueryDefs("qryCustomerOrdersParameter")
strSearchName = Forms![frmSearch]![txtCustomerToFind]
qdfMyQuery![Forms!frmSearch!txtCustomerToFind] = strSearchName

Set rstCountOrders = qdfMyQuery.OpenRecordset()

Note the important part in the last line that a lot of people miss; the recordset is opened on the QueryDef.

[Wombat]

Yeah, I JUST got a positive result and it was that last line that I noticed was different.

I decided to scrap the function, since it was not really re-useable with my other reports because the formatting is different anwyay, so I stripped everything out and put it behind the button to see if I could get the basics working and it seems like it does.

Set rst = CurrentDb.OpenRecordset(qdf)

became

Set rst = qdf.OpenRecordset()

and now it appears to work (only one test so far). I can't say that I really understand it.

[Wombat]

Ignore this post.. solved my own issue.

recordset doesn't work unless you're on the last record.

rst.moveLast
rowcount = rst.recordcount + 1

solved it.


Thanks again for your help, I think this thread is finished.

[pbaldy]

Happy to help.

[Wombat]

pbaldy, I just started working on another report where i have to read two date parameters and query for records that fall between. In trying to figure it out, I found this great bit of code...

Dim dbs As DAO.Database
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Dim rst As DAO.Recordset
    Set dbs = CurrentDb
    Set qdf = dbs.QueryDefs("qryWeeklyDamageReport")
    
    For Each prm In qdf.Parameters
        prm = Eval(prm.Name)
    Next prm
    
    Set rst = qdf.OpenRecordset

The eval(prn.Name) appears to make the VBA read the parameters as they're written in the query. It seems a simpler way of assigning them, assuming you are referencing controls on a form.

[pbaldy]

I agree, that's how I'd do it for more than one parameter.