How to get Access VBA to export query with Criteria into Excel file

[Bobfred]

Hi

I am trying to make a VBA module in Access to export a query from Access into an existing Excel file and worksheet.

From looking around on Youtube I have found the code below.

This works fine for queries where no input is required. However when I run my query a box pops up asking you to enter the Latitude followed by a box asking for Longitude. Once this criteria is input it will then run the query.

However the right you have to input values into the query seems to break the below code.

Any suggestions on how I can amend the below code so when I run the VBA Module it will run the query asking me for Lat and Long. Once I have input the values it will then export the data to an existing file called All and best.xlsm and paste it on the worksheet All??



Public Sub ExportToExcel()


Dim XL As Excel.Application
Dim wbTarget As Workbook


Dim qdfLocation As QueryDef
Dim rsLocation As Recordset


DoCmd.OpenQuery ("By Location - use coord calc")


Set qdfLocation = CurrentDb.QueryDefs("By Location - use coord calc")


Set rsLocation = qdfLocation.OpenRecordset()


Set XL = CreateObject("Excel.Application")


Set wbTarget = XL.Workbooks.Open("C:\Users\Bob\Desktop\All and best.xlsm")


wbTarget.Worksheets("All").Cells.ClearContents


wbTarget.Worksheets("All").Cells(1, 1).CopyFromRecordset rsLocation


wbTarget.Save


wbTarget.Close


Set wbTarget = Nothing
Set XL = Nothing


Set qdfLocation = Nothing


End Sub

 

[Trevor G]

Can you show the SQL in the query. I assume this is where the Parameter values are added.

 

[Bobfred]

The SQL in the background of the query is..

WHERE (((Measurements.Date)>Now()-730) AND ((Measurements.Latitude) Between [Enter Ymin] And [Enter Ymax]) AND ((Measurements.Longitude) Between [Enter Xmin] And [Enter Xmax]));

 

[Bobfred]

Also the original post had a line in there that should be DoCmd.OpenQuery ("By Location - use coord calc").


So the correct code is:

Public Sub ExportToExcel()


Dim XL As Excel.Application
Dim wbTarget As Workbook


Dim qdfLocation As QueryDef
Dim rsLocation As Recordset




Set qdfLocation = CurrentDb.QueryDefs("By Location - use coord calc")


Set rsLocation = qdfLocation.OpenRecordset()


Set XL = CreateObject("Excel.Application")


Set wbTarget = XL.Workbooks.Open("C:\Users\csurv\Desktop\All and best serving.xlsm")


wbTarget.Worksheets("All").Cells.ClearContents


wbTarget.Worksheets("All").Cells(1, 1).CopyFromRecordset rsLocation


wbTarget.Save


wbTarget.Close


Set wbTarget = Nothing
Set XL = Nothing


Set qdfLocation = Nothing


End Sub

 

[Bobfred]

It seems to error on the line

'Set rsLocation = qdfLocation.OpenRecordset()'

which makes me think its because of the Criteria the query is asking for

 

[Trevor G]

Can you upload a copy to dropbox or something like that and place a link into your thread I can take a look from there.