时间戳

首页 > 解决方案 > Excel VBA 中的 SQL 查询以从 Access 中提取信息

sql - Excel VBA 中的 SQL 查询以从 Access 中提取信息

问题描述

修改后的问题：我不习惯在 VBA 中编写 SQL 查询，所以我一直在使用宏录制来连接 Access。我已经包含了宏记录器返回的代码。我收到一条错误消息

意外的错误。出问题了。如果问题仍然存在，请重新启动 Excel。

如果我单击错误消息上的关闭，则带有 Access 数据库信息的电子表格会显示在 Excel 中，这很好，但我宁愿不弹出错误消息。

到目前为止，这是我的代码：

Sub Contact_Search()  

Dim ContactNum As String  
Restart:  
ContactNum = InputBox("Enter the number to query.", "Contact Query", "Enter the number here...")  
If ContactNum = "Enter the number here..." Then  
  MsgBox "Invalid response, please enter the number to query."  
  GoTo Restart  
ElseIf ContactNum = "" Then  
  MsgBox "Number is mandatory.  Please enter number."  
  GoTo Restart  
End If  

ActiveWorkbook.Worksheets.Add After:=Sheets(1)  
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _  
  "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=C:\Users\path info\folder name\Contacts " _  
  , _
  "Database.accbd;Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Da" _  
  , _
  "tabase Password="""";Jet OLEDB:Engine Type=6;Jet OLEDB:Database Locking Mod=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Globa" _  
  , _  
  "l Bulk Transactions=1;JetOLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False" _  
  , _  
  ";Jet OLEDB:Don't Copy Local on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Suppo" _  
  , _  
  "rt Complex Data+False;Jet OLEDB:Bypass User Info Validaton=False;Jet OLEDB:Limited DB Caching=False;Jet OLEDB;Bypass ChoiceField" _  
  ,  " Validation=False"), Destination:=Range("$A$1")).QueryTable  
.CommandType = xlCmdTable
.CommandText = Array("Contacts")
.PreserveFormatting = True
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells  
.SaveData = True  
.AdjustColumnWidth = True
.RefreshPeriod = 0  
.PreserveColumnInfo = True  
.SourceDataFile = "C:\Users\path info\folder name\Contacts\Database.accdb"  
.ListObject.DisplayName = "Table_Database.accdb"  
.Refresh BackgroundQuery:=False  
End With

End Sub

我确信这段代码中的大部分内容并不是真正需要的，它只是宏记录器放在那里的东西，但我不确定什么可以取出，什么必须在那里才能工作和我不确定代码中的某些内容是否导致了我收到的错误消息。正如我所说，信息仍在继续，但我必须在错误消息出现在 Excel 文档中之前关闭它。

此外，我实际上想要返回的不是整个表，而是与用户输入的变量 ContactNum 匹配的行。我不确定在这段代码中我会将 SQL 语言放在哪里只返回特定值而不是整个表。关于错误消息和 SQL 措辞的任何想法？

标签： sqlexcelvbams-access

解决方案

我使用 DAO 而不是 ADO 连接到 Access 数据库。下面是我使用的典型 Sub 示例。 

Sub AccessSQL(ByVal Var1 As String, ByVal Var2 As String)
    Dim DBPath As String
    Dim i As long
    Dim j As long
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim sSQL As String
    Dim xlCell As Range
        Set xlCell = Range("A1")
        DBPath = "C:\AccessDBS\DataDB.accdb"
        sSQL = "SELECT TableA.Field01, TableA.Field02, TableA.Field03 FROM TableA WHERE (((TableA.Field01) = '" & Var1 & "') And ((TableA.Field02) = '" & Var2 & "') And ((TableA.Field03) = 0) And (Not (TableA.Field04) = 0)) Or (((TableA.Field04) = 99999)) ORDER BY TableA.Field01;"
        Set db = OpenDatabase(DBPath)
        Set rs = db.OpenRecordset(sSQL, dbOpenSnapshot)
        If Not rs.EOF Then
            rs.MoveLast
            rs.MoveFirst
            i = rs.RecordCount
            If i > 0 Then
                rs.MoveFirst
                For j = 1 To i
                    With xlCell
                        .Value = rs!Field01 & " - " & rs!Field02 
                        .Offset(0,1).Value = rs!Field03
                    End With
                    rs.MoveNext
                    Set xlCell = xlCell.Offset(1,0)
                Next j
            Else
                xlCell.Value = "No Records Returned"
            End If
        Else
            xlCell.Value = "No Records Returned"
        End If
        rs.Close
        db.Close
        Set rs = Nothing
        Set db = Nothing
        Set xlCell = Nothing 
End Sub

上面的 sub 被提供了 2 个字符串变量，这些变量被合并到我的 SQL SELECT 语句中。然后循环遍历返回的记录并将它们放入 Excel 工作表中。当然，根据您需要对返回的数据做什么，您可以扩展它以执行计算或填充表单或其他任何东西上的组合框。

推荐阅读