如何通过Excel VBA操作Access创建查询并导出数据至Excel？

• 本人是VBA新手，需要自动化将MS Access数据库数据导出至Excel的流程
• 手动流程：在Access中创建关联两个表的查询，添加日期条件后运行并导出至Excel
• 当前进度：已实现通过VBA在Access中创建查询的代码，现需完成两个目标：
  1. 将Access中查询到的数据导出至Excel
  2. 实现点击Excel按钮时，打开指定Access数据库，以Excel选中单元格的日期范围作为查询条件，最终将数据导出到Excel

第一次尝试代码 #

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

已实现的创建查询代码 #

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

一、Access端导出查询到Excel的实现 #

在已有的创建查询代码后，添加TransferSpreadsheet方法即可完成导出，也可以直接创建临时查询导出，避免在Access中留下冗余查询对象：

Sub CreateQueryAndExport()
    Dim dbsAssetManagement As Database
    Dim qdfNew As QueryDef
    Dim exportPath As String
    
    ' 替换为实际Excel导出路径
    exportPath = "C:\YourFolder\ExportedData.xlsx"
    
    ' 打开目标Access数据库
    Set dbsAssetManagement = OpenDatabase("C:\YourFolder\AssetManagement.accdb")
    
    With dbsAssetManagement
        ' 创建临时查询（命名为空字符串即为临时查询，无需保留）
        Set qdfNew = .CreateQueryDef("", _
            "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#")
        
        ' 导出查询结果到Excel，True表示包含字段名
        .TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, _
            qdfNew.Name, exportPath, True
        
        ' 删除临时查询
        .QueryDefs.Delete qdfNew.Name
    End With
    
    ' 释放对象
    Set qdfNew = Nothing
    Set dbsAssetManagement = Nothing
    
    MsgBox "数据导出完成！"
End Sub

二、Excel端触发的完整实现（点击按钮执行） #

1. 操作步骤：打开Excel → 开发工具 → 插入 → 按钮（表单控件）→ 拖到工作表上并指定宏
2. 编写以下VBA代码，需提前添加DAO库引用（工具 → 引用 → 勾选Microsoft DAO 3.6 Object Library）：

Sub ExportFromAccessByDate()
    Dim dbs As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim startDate As Date, endDate As Date
    Dim exportSheet As Worksheet
    Dim accessPath As String
    
    ' 替换为实际Access数据库路径
    accessPath = "C:\YourFolder\AssetManagement.accdb"
    
    ' 校验选中的日期范围（需选中两个单元格，分别为开始/结束日期）
    If Selection.Cells.Count <> 2 Then
        MsgBox "请选中两个单元格，分别作为开始日期和结束日期！"
        Exit Sub
    End If
    startDate = Selection.Cells(1).Value
    endDate = Selection.Cells(2).Value
    
    ' 设置导出目标工作表（此处用当前活动表，可按需修改）
    Set exportSheet = ActiveSheet
    
    ' 打开Access数据库
    Set dbs = OpenDatabase(accessPath)
    
    ' 创建临时查询，动态拼接日期条件（Access日期需用#包裹，格式统一为mm/dd/yyyy）
    Set qdf = dbs.CreateQueryDef("", _
        "SELECT [(MR)Events2025].*, [(MR)EventMemo2025].* " & _
        "FROM [(MR)Events2025] INNER JOIN [(MR)EventMemo2025] " & _
        "ON [(MR)Events2025].MCN = [(MR)EventMemo2025].MCN_ID " & _
        "WHERE [(MR)Events2025].EvtDate >= #" & Format(startDate, "mm/dd/yyyy") & "# " & _
        "AND [(MR)Events2025].EvtDate <= #" & Format(endDate, "mm/dd/yyyy") & "#")
    
    ' 清空目标工作表原有数据（可选）
    exportSheet.Cells.Clear
    
    ' 将查询结果导入Excel
    exportSheet.QueryTables.Add _
        Connection:="ODBC;DSN=MS Access Database;DBQ=" & accessPath & ";", _
        Destination:=exportSheet.Range("A1"), _
        Sql:=qdf.SQL
    
    ' 执行数据导入
    exportSheet.QueryTables(1).Refresh BackgroundQuery:=False
    
    ' 清理临时查询与对象
    dbs.QueryDefs.Delete qdf.Name
    Set qdf = Nothing
    Set dbs = Nothing
    
    MsgBox "数据导入完成！"
End Sub

关键注意事项 #

• 日期格式：Access中日期需用#包裹，且统一转换为mm/dd/yyyy格式，避免区域设置差异导致的错误
• DAO引用：Excel端必须添加DAO库引用，否则会出现对象未定义的报错
• 临时查询：使用空字符串命名的临时查询，无需在Access中保留，用完即删，避免冗余
• 路径替换：所有文件路径需替换为你实际的文件存储路径

内容的提问来源于stack exchange，提问作者Darth Slader