在Excel 2007中从宏中调用Access 2007中的查询

时间:2013-10-28 15:27:23

标签: excel vba ms-access

我有一个数据库,它链接到CSV文件。数据库的名称为 AllInformation ,存储在路径= some_path 中。在 AllInformation 中,我有一个带参数的查询(名为 MyQuery )。它的名字是 [当前日期] ,后者的类型是日期。

1)如何从Excel VBA代码(我使用Excel 2007)连接到数据库 - AllInformation ?数据库 AllInformation ,没有任何密码。 2)如何使用设置参数 [当前日期] 运行查询 - MyQuery ? 3)如何将 MyQuery 的结果复制到Excel工作表中?

我需要这个,因为直接在CSV文件中搜索非常耗时。 MyQuery 在4分钟内找到我需要的内容,而在CSV文件中通过VBA直接搜索大约需要1小时。

感谢您的回答。

2 个答案:

答案 0 :(得分:0)

作为旁注,您编写的用于直接搜索CSV文件的代码可能存在一些设计问题,这使得搜索时间变得非常低效。

那就是说,做到以下几点:

  1. 将对Access数据库引擎的引用添加到Excel VBA项目。在Office 2010中,它将引用Microsoft Office 14.0 Access database engine Object Library。该库为Access数据库引擎提供了基于DAO的接口。
  2. 了解如何在Google上使用DAO。查找如何使用参数运行查询。
  3. 另请参阅如何将DAO记录集复制到Excel电子表格中。
  4. 这些是您要问的常见任务。如果你花几秒钟的时间搜索,你应该可以在网上找到很多答案。我已经提供了足够的信息,你应该能够找到答案。

答案 1 :(得分:0)

我已经从Excel VBA中找到了这个,查询Ac​​cess 2007 X.accdb文件:

'
' Variables:
'   i: counter
'   j: counter
'   nFlds: number of fields in the query
'   nMax: maximum number of records to be exported, 0=no limit
'   strQry: query name
'
'   objApp: Access.Application
'   qdf: QueryDef
'   rst: Recordset
'
Function daoDoQuery()
'
  Dim i, j, nFlds, nMax, strQry
'
  Dim objApp, qdf
  Dim rst As DAO.Recordset
'
  Set objApp = CreateObject("Access.Application")
  objApp.OpenCurrentDatabase "some_path\AllInformation.accdb"
'
' get Recordset:
'
  strQry = "MyQuery"
  Set qdf = objApp.CurrentDb.QueryDefs(strQry)
'
' here [Current date] is entered:
'
  qdf.Parameters(0).Value = Now()
  Set rst = qdf.OpenRecordset(dbOpenDynaset)
'
  If (rst.EOF) Then
    Set rst = Nothing
    daoDoQuery = 0
    Exit Function
  End If
'
  nFlds = rst.Fields.Count
'
' create a new Excel Workbook to write results:
'
  i = 1
  Application.ScreenUpdating = False
  Workbooks.Add
  For j = 1 To nFlds
    With Cells(i, j)
      .Font.Bold = True
      .Font.Size = 12
      .Value = rst.Fields(j - 1).Name
    End With
  Next
'
  nMax = 50
  i = i + 1
'
  Do While (Not rst.EOF)
    '
    For j = 1 To nFlds
      Cells(i, j).Value = rst(j - 1)
    Next
    '
    rst.MoveNext
    i = i + 1
    If (nMax > 0) Then
      If (i > nMax) Then
        Exit Do
      End If
    End If
  Loop
'
  Application.ScreenUpdating = True
'
  rst.Close
  Set rst = Nothing
  Set qdf = Nothing
  Set objApp = Nothing
'
  daoDoQuery = 1
'
End Function

这将完成工作,il将创建一个新的Excel工作簿,第一个工作表作为结果列表:

daoDoQuery