Link to home
Start Free TrialLog in
Avatar of RishiSingh05
RishiSingh05Flag for United States of America

asked on

Run queries using a macro

I would like a macro or vba snippet that can execute the following actions in an Access db:

1. Run the following make table queries:
      1JerryToNMRemitDatav2
      q_CountyState
      q_StatePCPcounty
2. Run queries:
      M1Revenue1
      M1Revenue2_falloff
      MedicalCost1
      MedicalCost2
      Members1
     Members2

3. Open Excel and write the output of each of the above six queries consecutively on Sheet1.

Thanks !!
Avatar of Helen Feddema
Helen Feddema
Flag of United States of America image

You can't do all of this in a macro (particularly the Excel portion), but you can certainly create a function to do these tasks and run it from a macro, using a RunCode action.  You can run action queries (make-table, update, delete) this way.  What type are the queries in the 2nd group?

I like to give make-table queries the prefix "qmak" and the tables they create the same base name with the "tmak" prefix, so I know that (for example) qmakInvoice makes the table tmakInvoice.  Here is some code that will run a make-table query and import the table it creates to a new workbook:
Public Function RunQueriesAndExportToExcel()
'Created by Helen Feddema 10-Feb-2010
'Last modified by Helen Feddema 10-Feb-2010

On Error GoTo ErrorHandler
   
   Dim strWorkbook As String
   Dim strTable As String
   
   DoCmd.SetWarnings False
   DoCmd.OpenQuery "qmakCAContacts"
   strTable = "tmakCAContacts"
   strWorkbook = Application.CurrentProject.Path & "\" & "New Workbook.xls"
   DoCmd.TransferSpreadsheet transfertype:=acExport, _
      spreadsheettype:=acSpreadsheetTypeExcel8, _
      TableName:=strTable, _
      FileName:=strWorkbook, _
      hasfieldnames:=True
   
ErrorHandlerExit:
   Exit Function

ErrorHandler:
   MsgBox "Error No: " & Err.Number _
      & " in RunQueriesAndExportToExcel procedure; " _
      & "Description: " & Err.Description
   Resume ErrorHandlerExit

End Function

Open in new window

If the queries in the second group are select queries (with no parameters), they can also be exported to Excel using TransferSpreadsheet.
Avatar of RishiSingh05

ASKER

The six queries are all select queries.
Note that I don't need the tables (made by the make table queries) to go in Excel.
am I good to go then?
Are the queries in the second group based on the output of the make-table queries?

If so, you can run the make-table queries, and then export each of the other queries to a separate workbook using TransferSpreadsheet.  If you want them to all be in the same workbook (perhaps on different sheets), that would take some VBA coding.  How exactly do you want to the data to appear in Excel?
It might be best to prepare an Excel template, set up as you wish, with named sheets, and export the data to a workbook created from the template.
Yes the queries do need the tables created by the make table queries.  The entire output of each of the six queries in the second group need to go on the same worksheet of the same workbook.  If it is easier to put them in separate worksheets of the same workbook that will work too, but I would prefer them to be on the same sheet   .... one output after another without a blank row separating the outputs.  
I want to automate the process as we have more databases with queries to provide output to Excel.  Once I see how it's done I can do the others myself.
I will work up some code and post it shortly.
Thanks!!  No rush.  Tomorrow will do just as well.
I tried using CopyFromRecordset using an Excel range, but it wouldn't work when run from Access VBA.  It does run from Excel VBA in a workbook.  Is that an acceptable alternative?  
This function should do it (with your query names):
Public Function RunQueriesAndExportToExcel()
'Created by Helen Feddema 10-Feb-2010
'Last modified by Helen Feddema 10-Feb-2010

On Error GoTo ErrorHandler
   
   Dim appExcel As New Excel.Application
   Dim cnn As ADODB.Connection
   Dim wkb As Excel.Workbook
   Dim sht As Excel.Worksheet
   Dim strWorkbook As String
   Dim strRange As String
   Dim lngLastRow As Long
   Dim rst As ADODB.Recordset
   Dim rng As Excel.Range
   Dim strWorkbookName As String
   Dim strDefault As String
   
   DoCmd.SetWarnings False
   strPrompt = "Enter workbook name (no extension)"
   strTitle = "Workbook name"
   strDefault = "New Access Data"
   strWorkbookName = InputBox(strPrompt, strTitle, strDefault)
   
   'Run make-table queries
   DoCmd.OpenQuery "qmakCAContacts"
   
   Set cnn = CurrentProject.Connection
   Set rst = New ADODB.Recordset
   
   'Create a recordset based on a select query.
   rst.Open Source:="qryContacts", _
      ActiveConnection:=cnn.ConnectionString, _
      CursorType:=adOpenForwardOnly
      
   'Export first query
   Set wkb = appExcel.Workbooks.Add
   appExcel.Visible = True
   strWorkbook = Application.CurrentProject.Path & "\" & strWorkbookName
   wkb.SaveAs FileName:=strWorkbook
   Set sht = wkb.Sheets(1)
   strRange = "A1"
   Set rng = sht.Range(strRange)
   rng.CopyFromRecordset rst
   rst.Close
   
   'Export second query
   rst.Open Source:="qryTasks", _
      ActiveConnection:=cnn.ConnectionString, _
      CursorType:=adOpenForwardOnly
   lngLastRow = sht.UsedRange.Rows.Count
   strRange = "A" & CStr(lngLastRow + 2)
   Debug.Print strRange
   Set rng = sht.Range(strRange)
   rng.CopyFromRecordset rst
   rst.Close
   
   'Export third query
   rst.Open Source:="qryAppointments", _
      ActiveConnection:=cnn.ConnectionString, _
      CursorType:=adOpenForwardOnly
   lngLastRow = sht.UsedRange.Rows.Count
   strRange = "A" & CStr(lngLastRow + 2)
   Debug.Print strRange
   Set rng = sht.Range(strRange)
   rng.CopyFromRecordset rst
   rst.Close
   
ErrorHandlerExit:
   Exit Function

ErrorHandler:
   MsgBox "Error No: " & Err.Number _
      & " in RunQueriesAndExportToExcel procedure; " _
      & "Description: " & Err.Description
   Resume ErrorHandlerExit

End Function

Open in new window

As you can see, I did get it working from Access after all.
For some reason, DAO recordsets didn't work, but ADO recordsets did.
Thanks for your efforts.  I will look at the function and I may have some questions.  Thanks again.
Questions:

1) There are 3 make table queries I need to run.  

   'Run make-table queries
   DoCmd.OpenQuery "qmakCAContacts"    
' I will need to repeat the above command 3 times with my query names, correct?

2) Your code:
'Create a recordset based on a select query.
   rst.Open Source:="qryContacts", _
      ActiveConnection:=cnn.ConnectionString, _
      CursorType:=adOpenForwardOnly
' since I need to run 6 select queries, will I need to repeat the above block of code 5 more times (using my query names of course)?
ASKER CERTIFIED SOLUTION
Avatar of Helen Feddema
Helen Feddema
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
thanks  ... here is what it now looks like. Pls give it a once over.  I will need to remove the double quote marks around the query names.


Public Function RunQueriesAndExportToExcel()
'Created by Helen Feddema 10-Feb-2010
'Last modified by Helen Feddema 10-Feb-2010


On Error GoTo ErrorHandler
   
   Dim appExcel As New Excel.Application
   Dim cnn As ADODB.Connection
   Dim wkb As Excel.Workbook
   Dim sht As Excel.Worksheet
   Dim strWorkbook As String
   Dim strRange As String
   Dim lngLastRow As Long
   Dim rst As ADODB.Recordset
   Dim rng As Excel.Range
   Dim strWorkbookName As String
   Dim strDefault As String
   
   DoCmd.SetWarnings False
   strPrompt = "Enter workbook name (no extension)"
   strTitle = "Workbook name"
   strDefault = "New Access Data"
   strWorkbookName = InputBox(strPrompt, strTitle, strDefault)
   
   'Run 3 make-table queries
   DoCmd.OpenQuery "1JerryToNMRemitDatav2"
   DoCmd.OpenQuery "q_CountyState"
   DoCmd.OpenQuery "q_StatePCPCounty"


   Set cnn = CurrentProject.Connection
   Set rst = New ADODB.Recordset
   
   'Create a recordset based on a select query.
   rst.Open Source:=" m1Revenue1", _
      ActiveConnection:=cnn.ConnectionString, _
      CursorType:=adOpenForwardOnly
      
   'Export query 1
   Set wkb = appExcel.Workbooks.Add
   appExcel.Visible = True
   strWorkbook = Application.CurrentProject.Path & "\" & strWorkbookName
   wkb.SaveAs FileName:=strWorkbook
   Set sht = wkb.Sheets(1)
   strRange = "A1"
   Set rng = sht.Range(strRange)
   rng.CopyFromRecordset rst
   rst.Close
   
   'Export query 2
   rst.Open Source:="m1Revenue2_falloff", _
      ActiveConnection:=cnn.ConnectionString, _
      CursorType:=adOpenForwardOnly
   lngLastRow = sht.UsedRange.Rows.Count
   strRange = "A" & CStr(lngLastRow + 2)
   Debug.Print strRange
   Set rng = sht.Range(strRange)
   rng.CopyFromRecordset rst
   rst.Close
   
   'Export query 3
   rst.Open Source:="MedicalCost1", _
      ActiveConnection:=cnn.ConnectionString, _
      CursorType:=adOpenForwardOnly
   lngLastRow = sht.UsedRange.Rows.Count
   strRange = "A" & CStr(lngLastRow + 2)
   Debug.Print strRange
   Set rng = sht.Range(strRange)
   rng.CopyFromRecordset rst
   rst.Close

   'Export query 4
   rst.Open Source:="MedicalCost2", _
      ActiveConnection:=cnn.ConnectionString, _
      CursorType:=adOpenForwardOnly
   lngLastRow = sht.UsedRange.Rows.Count
   strRange = "A" & CStr(lngLastRow + 2)
   Debug.Print strRange
   Set rng = sht.Range(strRange)
   rng.CopyFromRecordset rst
   rst.Close

'Export query 5
   rst.Open Source:="Members1", _
      ActiveConnection:=cnn.ConnectionString, _
      CursorType:=adOpenForwardOnly
   lngLastRow = sht.UsedRange.Rows.Count
   strRange = "A" & CStr(lngLastRow + 2)
   Debug.Print strRange
   Set rng = sht.Range(strRange)
   rng.CopyFromRecordset rst
   rst.Close


   'Export query 6
   rst.Open Source:="Members2", _
      ActiveConnection:=cnn.ConnectionString, _
      CursorType:=adOpenForwardOnly
   lngLastRow = sht.UsedRange.Rows.Count
   strRange = "A" & CStr(lngLastRow + 2)
   Debug.Print strRange
   Set rng = sht.Range(strRange)
   rng.CopyFromRecordset rst
   rst.Close








   
ErrorHandlerExit:
   Exit Function

ErrorHandler:
   MsgBox "Error No: " & Err.Number _
      & " in RunQueriesAndExportToExcel procedure; " _
      & "Description: " & Err.Description
   Resume ErrorHandlerExit

End Function

Open in new window

Also, I attempted to compile and got this error: “User-defined type not defined” for line:
Dim appExcel As New Excel.Application