Question

修订后的问题：我不习惯在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语言的任何想法？

Answer 1

我与Access数据库的连接使用DAO而不是ADO。以下是我使用的典型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

上面的子项被喂入2个字符串变量，这些变量已合并到我的SQL SELECT语句中。然后，它循环浏览返回的记录，并将它们放入excel工作表中。当然，根据您需要对返回的数据执行什么操作，您可以扩展它以执行计算或在表单或其他任何内容上填充组合框。

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

1 个答案: