How do you create a query in MS Access using VBA?-CodePudding

I am trying to automate a process of exporting data from a database in MS Access to excel using VBA. When I do it regularly (excuse my lack of proper verbiage as I am a complete newb at this), I start by creating a query linking two tables. I double click the asterisk to show the tables. I add one of the column headers as a field in the query and add the criteria I need. Then I run the query and export it to excel.

I have tried using Google to solve my issue and I have tried to copy and paste the SQL from the query into VBA. I think the latter could work but it is missing the first step I think but I am not sure what that step is.

Edit: This is one attempt I've made with help from the internet.

Sub createQry()
    Dim db As DAO.Database
    Set db = CurrentDb
    Dim qdf As DAO.QueryDef
    Dim newSQL As String

    newSQL = "Select * From [(MR)Events2025] And [(MR)EventMemo2025]     WHERE [EvtDate]= >=#1/1/2022# And <=#1/31/2022#"


End Sub

I want to make it to where I can click a button in excel and it run the process of creating the query in access and then exporting it to excel. The file changes monthly with updated data and I would like to not have to do the same thing every month and just click a button to get the data I want. If it were all in excel I would be fine because of the record macro feature but it doesn't seem to work outside of excel.

I guess what I want the code to do is open the access database when I click a button in excel, create the query in access (this includes copying a date range from the cell I have selected and pasting it in the criteria portion of the query, or just having that part of the query equal the selected cell in excel), and export the data from the query to excel. I can figure the other stuff I want to do via the macro recorder.

The below creates the query for me, now I have to export it to excel.

Sub CreateQueryDefX()
 
   Dim dbsAssetManagement As Database
   Dim qdfTemp As QueryDef
   Dim qdfNew As QueryDef
 
   Set dbsAssetManagement = OpenDatabase("C:(deleted file location for privacy)AssetManagement.accdb")
 
   With dbsAssetManagement
     
      Set qdfNew = .CreateQueryDef("NewQueryDef", _
         "SELECT [(MR)Events2025].*, [(MR)EventMemo2025].* FROM [(MR)Events2025] INNER JOIN [(MR)EventMemo2025] ON [(MR)Events2025].MCN = [(MR)EventMemo2025].MCN_ID WHERE ((([(MR)Events2025].EvtDate) >=#1/1/2022# And ([(MR)Events2025].EvtDate)<=#1/31/2022#))")
     
   End With
 
End Sub

CodePudding user response：

You can save the query/queries you want to export and then in VBA export them to files using the TransferSpreadsheet method

See https://learn.microsoft.com/en-us/office/vba/api/access.docmd.transferspreadsheet

Example:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, 
"staff_list_with_grouping", "C:\test\test.xlsx", True

Alternatively you can do the following steps in VBA (1) create an Excel object , (2) open a blank workbook, (3) open the query you want to export, (4) copy its data (5) paste the data in the Excel workbook, (6) save the workbook , (7) reclose your query

Example of code exporting a query to an existing Excel template:

Sub ExportSearchResults()


DoCmd.OpenQuery ("MyQuery")
DoCmd.RunCommand acCmdSelectAllRecords
DoCmd.RunCommand acCmdCopy


Dim xlo As New Excel.Application

xlo.Workbooks.Add (getTemplateFolder & "ExportTemplate.xlsx")

xlo.ActiveSheet.Range("D1").Value = Now()
xlo.ActiveSheet.Range("A4").Select

xlo.ActiveSheet.PasteSpecial Format:="Unicode Text"

xlo.ActiveSheet.Cells.Select
xlo.Selection.ColumnWidth = 30
xlo.Selection.RowHeight = 15
xlo.ActiveSheet.Cells.Select
xlo.ActiveSheet.Cells.EntireColumn.AutoFit
xlo.ActiveSheet.Cells.Select
xlo.ActiveSheet.Cells.EntireRow.AutoFit



xlo.Visible = True
xlo.UserControl = True
xlo.WindowState = -4137 
xlo.Range("A1").Select


End Sub

CodePudding user response：

I was originally trying to do this in Access but I was eventually able to find a video for VBA in excel. It pulls all the data that I want.

Sub getDataFromAccess()
' Click on tools, references and select
' the Microsoft ActiveX Data Objects 2.0 Library

Dim DBFullName As String
Dim Connect As String, Source As String
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Dim Col As Integer

Cells.Clear

' Database path info
DBFullName = "C:(deleted file location for privacy)AssetManagement.accdb"

' Open the connection
Set Connection = New ADODB.Connection
Connect = "Provider=Microsoft.ACE.OLEDB.12.0;"
Connect = Connect & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Connect

'Create RecordSet
Set Recordset = New ADODB.Recordset
With Recordset
'Filter Data
Source = "SELECT [(MR)Events2025].*, [(MR)EventMemo2025].* FROM [(MR)Events2025] INNER JOIN [(MR)EventMemo2025] ON [(MR)Events2025].MCN = [(MR)EventMemo2025].MCN_ID WHERE ((([(MR)Events2025].EvtDate) >=#1/1/2022# And ([(MR)Events2025].EvtDate)<=#1/31/2022#))"

.Open Source:=Source, ActiveConnection:=Connection

'MsgBox "The Query:" & vbNewLine & vbNewLine & Source

'Write field names
For Col = 0 To Recordset.Fields.Count - 1
 Range("A1").Offset(0, Col).Value = Recordset.Fields(Col).Name
Next

'Write Recordset
Range("A1").Offset(1, 0).CopyFromRecordset Recordset
End With
ActiveSheet.Columns.AutoFit
Set Recordset = Nothing
Connection.Close
Set Connection = Nothing


End Sub