Query with Criteria export to excel HELP...

[smally006]

Hi,

I have been searching on the net for the past few hours and no success so any help will be appriciated. So far i have a query "FullAreaExport" this uses a criteria for which is fetches from a combo box on my form. when i run the query from the form it works fine but what i want to do is have it export to excel. The export code i have and it works on other queries without the criteria. Please can someone assist me..... this is my code so far:

Private Sub Command293_Click()

On Error Resume Next


strQueryName = "FullAreaExport"


Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWorkbook = xlApp.Workbooks.Add
Set objRST = Application.CurrentDb.OpenRecordset(strQueryName)


Set xlSheet = xlWorkbook.Sheets(1)
For lvlColumn = 0 To objRST.Fields.Count - 1
xlSheet.Cells(1, lvlColumn + 1).Value = objRST.Fields(lvlColumn).Name
Next

xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, objRST.Fields.Count)).Font.Bold = True


With xlSheet
.Range("A2").CopyFromRecordset objRST
.Name = Left(strQueryName, 31)
.Columns("A:AZ").EntireColumn.Autofit
End With

Set xlSheet = Nothing
Set xlWorkbook = Nothing
Set xlApp = Nothing

End Sub

 

[pbaldy]

Are you getting this error:

http://support.microsoft.com/default.aspx?scid=kb;en-us;209203

 

[smally006]

Hi,

thanks for the swift reply, at the moment i get no errrors at all.... my excel sheet loads up and names the sheet the same as my query but no data is entered into it. I think i need to put the criteria code into VB rather than it sat as code in the query itself..

 

[pbaldy]

Ah, you're probably not getting an error because of this:

On Error Resume Next

which I wouldn't recommend doing.

 

[smally006]

Thanks, yes i do now get an error on access, "too few parameters, expected 1" I have looked at that link to microsoft but as a bit of a novice its confused me.

How can i work that into my VB code? I want it to pick up the parameter from my combo box so i dont want to hardcode or ask the user to type it in.

thanks

 

[pbaldy]

If you look at the function in step 4 of their process, it includes the type of code you can adapt to yours. Basically you'll use the QueryDef to set the parameters of the query to the value on the form, then open the recordset on the QueryDef.

 

[smally006]

So i have adapted the code i think to fit my database, but i get data mismatch errors. A debug shows on the "Set rstCountOrders = qdfMyQuery.OpenRecordset()" Im not sure what the rstcountorders is.....

my code at the moment is:

Private Sub Command293_Click()

strQueryName = "FullAreaExport"


   
    Dim rstCountOrders As Recordset
    Dim strSearchName As String

    Set dbSample = CurrentDb()

    Set qdfMyQuery = dbSample.QueryDefs("FullAreaExport")
    
    ' Test for a value in the textbox
    If Not IsNull(Forms![RadioDatabase]![OUAREAEXP]) Then
    
        ' Set the value of the parameter.
        strSearchName = Forms![RadioDatabase]![OUAREAEXP]
        qdfMyQuery![Forms!RadioDatabase!OUAREAEXP] = strSearchName

        ' Create the recordset (or dynaset).
        Set rstCountOrders = qdfMyQuery.OpenRecordset()
End If

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWorkbook = xlApp.Workbooks.Add
Set objRST = Application.CurrentDb.OpenRecordset(strQueryName)


Set xlSheet = xlWorkbook.Sheets(1)
For lvlColumn = 0 To objRST.Fields.Count - 1
xlSheet.Cells(1, lvlColumn + 1).Value = objRST.Fields(lvlColumn).Name
Next

xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, objRST.Fields.Count)).Font.Bold = True


With xlSheet
.Range("A2").CopyFromRecordset objRST
.Name = Left(strQueryName, 31)
.Columns("A:AZ").EntireColumn.Autofit
End With

Set xlSheet = Nothing
Set xlWorkbook = Nothing
Set xlApp = Nothing

End Sub

Thanks for your help so far it is much appriciated.

 

[pbaldy]

A case of poor coding in the sample. Make sure in Tools/References that the MS DAO reference is checked, then change this line to:

Dim rstCountOrders As DAO.Recordset

rstCountOrders is simply what they called the recordset, whereas you had objRST. You can leave it as that if you want.

 

[smally006]

Changed that, i had to delete "Dim rstCountOrders As Recordset" from the start as it mentioned duplicate data... I still get a mismatch error. This time according to debug on "Set qdfMyQuery = dbSample.QueryDefs("FullAreaExport")" .

thanks once again

 

[c_smithwick]

Try the following

 Set rstCountOrders = dbSample.OpenRecordset(qdfMyQuery.SQL, dbOpenDynaset)

 

[pbaldy]

Well, you don't declare all your variables like you should. Try adding these two lines:

Dim dbSample As DAO.Database
Dim qdfMyQuery As DAO.QueryDef

If that doesn't do it, can you post the db?

 

[smally006]

Thanks to you both for assisting.

I have been playing around and have got it passed to first part of code, but now i am getting type mismatch errors in my second part of the code. (this code still works on other queries where parametres are not needed)

debug shows the error on "Set objRST = Application.CurrentDb.OpenRecordset(strQueryName)"

my full code now is:

Private Sub Command293_Click()


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

    Set dbSample = CurrentDb()
    
    Set qdfMyQuery = dbSample.QueryDefs("FullAreaExport")
    
    ' Test for a value in the textbox
    If Not IsNull(Forms![RadioDatabase]![OUAREAEXP]) Then
    
        ' Set the value of the parameter.
        strSearchName = Forms![RadioDatabase]![OUAREAEXP]
        qdfMyQuery![Forms!RadioDatabase!OUAREAEXP] = strSearchName

   ' Create the recordset (or dynaset).
        Dim rstCountOrders As DAO.Recordset
    
     
End If

Set strQueryName = CurrentDb.QueryDefs("FullAreaExport")

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWorkbook = xlApp.Workbooks.Add
Set objRST = Application.CurrentDb.OpenRecordset(strQueryName)


Set xlSheet = xlWorkbook.Sheets(1)
For lvlColumn = 0 To objRST.Fields.Count - 1
xlSheet.Cells(1, lvlColumn + 1).Value = objRST.Fields(lvlColumn).Name
Next

xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, objRST.Fields.Count)).Font.Bold = True


With xlSheet
.Range("A2").CopyFromRecordset objRST
.Name = Left(strQueryName, 31)
.Columns("A:AZ").EntireColumn.Autofit
End With

Set xlSheet = Nothing
Set xlWorkbook = Nothing
Set xlApp = Nothing

End Sub

I am afraid i cannot upload my database as it contains some confidential information. thanks in advance for you assistance.