excel 如何使用VBA在MS Access中创建查询?

i2loujxw  于 2023-01-27  发布在  其他
关注(0)|答案(2)|浏览(229)

我正在尝试使用VBA自动化从MS Access中的数据库导出数据到Excel的过程。当我定期这样做时(请原谅我缺乏适当的措辞,因为我在这方面完全是个新手),首先创建一个链接两个表的查询。双击星号以显示表。在查询中添加一个列标题作为字段,并添加所需的条件。然后运行查询并将其导出到excel。
我试过使用谷歌来解决我的问题,我试过从查询中复制SQL并粘贴到VBA中。我认为后者可以工作,但它错过了第一步,我认为,但我不确定那一步是什么。
编辑:这是我在互联网帮助下做的一次尝试。

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

我想让它在那里我可以点击一个按钮在excel和它运行的过程中创建的查询access,然后将其导出到excel。该文件每月更改更新的数据,我想不必做同样的事情,每个月,只是点击一个按钮,以获得我想要的数据。如果它都在excel中,我会很好,因为记录宏功能,但它没有'在excel之外似乎无法工作。
我想我希望代码做的是当我单击excel中的按钮时打开access数据库,在access中创建查询(这包括从我选择的单元格中复制一个日期范围并将其粘贴到查询的条件部分,或仅使查询的该部分等于Excel中的选定单元格),并将查询中的数据导出到Excel中。我可以通过宏记录器计算出我想做的其他事情。
下面为我创建了查询,现在我必须将其导出到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
zpgglvta

zpgglvta1#

您可以保存要导出的查询,然后在VBA中使用TransferSpreadsheet方法将其导出到文件
参见https://learn.microsoft.com/en-us/office/vba/api/access.docmd.transferspreadsheet
示例:

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

或者,您可以在VBA中执行以下步骤:(1)创建Excel对象,(2)打开空白工作簿,(3)打开要导出的查询,(4)复制其数据,(5)将数据粘贴到Excel工作簿中,(6)保存工作簿,(7)重新关闭查询
将查询导出到现有Excel模板的代码示例:

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
i7uaboj4

i7uaboj42#

我最初试图在Access中这样做,但我最终能够在Excel中找到VBA的视频。它拉取所有我想要的数据。

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

相关问题