SQL-запрос в Excel VBA для извлечения информации из Access

Question

Пересмотренный вопрос: я не привык писать SQL-запросы в VBA, поэтому использую запись макросов для подключения к Access.Я включил код, который возвращает рекордер макросов.Я получаю сообщение об ошибке

Неожиданная ошибка.Что-то пошло не так.Если проблема не устранена, перезапустите Excel.

Если я нажму кнопку Закрыть на сообщении об ошибке, тогда в Excel появится таблица с информацией о базе данных из Access, и это здорово, но я бы не сталвсплывающее сообщение об ошибке.

Вот мой код:

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

Я использую 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

В вышеприведенном подпрограмме вводятся 2 строковые переменные, которые включены в мой оператор SQL SELECT.Затем он циклически просматривает возвращенные записи и помещает их в таблицу Excel.Конечно, в зависимости от того, что вам нужно делать с возвращаемыми данными, вы можете расширить это, чтобы выполнить вычисления или заполнить поля со списком в формах или чем-то еще.