Question

所以目前我有代码使用Excel VBA将整个表中的信息从Access导入Excel。有没有办法我可以在Excel VBA for Access中运行查询，然后只是拉他们查询数据？

截至目前我的拉码：

    Sheets(q).Select
    tablename = Sheets(q).Name
    Set cnt = New ADODB.Connection
    dbPath = "\FIMS_CDFT_Database.mdb"
    sPath = ActiveWorkbook.Path
    dbConnectStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & sPath & dbPath & ";"
    With cnt
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open dbConnectStr
    End With
    sCmndString = "SELECT * FROM " & tablename
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open sCmndString, cnt, 2, 3, 1

     'transfer data to Excel
    Range("A4").CopyFromRecordset rs

Answer 1

以下是打开Access查询并将数据导入ActiveSheet的解决方案：

'
' inputs:
'   strDbName: database filename
'   strQry: query name
'   strDataSheet: destination DataSheet name, to be erased with newdata
'
Function daoDoQueryCopyRecordset(ByVal strDbName, ByVal strQry, _
  ByVal strDataSheet)
'
  Dim objApp, qdf
  Dim rst As DAO.Recordset
'
  Set objApp = CreateObject("Access.Application")
'
  objApp.OpenCurrentDatabase strDbName
'
' get Recordset:
'
  Set qdf = objApp.CurrentDb.QueryDefs(strQry)
  Set rst = qdf.OpenRecordset(dbOpenDynaset)
'
  If (rst.EOF) Then
    Set rst = Nothing
    Set qdf = Nothing
    objApp.Quit
    Set objApp = Nothing
    daoDoQueryCopyRecordset = 0
    Exit Function
  End If
'
' create a new Excel Workbook to write results:
'
  Application.ScreenUpdating = False
'
' Workbooks.Add
'
' transfer data to Excel:
'
  ActiveWorkbook.Sheets(strDataSheet).Select
'
  ActiveSheet.Range("A4").CopyFromRecordset rst
'
  Application.ScreenUpdating = True
'
  rst.Close
  Set rst = Nothing
  Set qdf = Nothing
  objApp.Quit
  Set objApp = Nothing
'
  daoDoQueryCopyRecordset = 1
'
End Function


Function daoDoQueryCopyRecordsetNoParams()
'
  Dim strDbName, strQry, strDataSheet
'
  strDbName = ActiveWorkbook.Path & "\FIMS_CDFT_Database.mdb"
  strDataSheet = ActiveSheet.Name
  strQry = strDataSheet
'
  daoDoQueryCopyRecordsetNoParams = _
    daoDoQueryCopyRecordset(strDbName, strQry, strDataSheet)
'
End Function

使用以下方法调用任何Excel宏中的最后一个函数：

daoDoQueryCopyRecordsetNoParams

!!!小心，当前的数据表将被新数据删除。

将信息从Access拉入Excel

1 个答案: