Использование Excel VBA ODBC для импорта данных Microsoft Pass Pass Through Query

Я пытаюсь получить доступ к SQL Pass Through Query из Excel VBA и двух столбцов данных из него. Ранее я использовал этот код для подключения к таблице доступа, и когда я изменил его для подключения к запросу Pass Pass Through Query, он выдал ошибку "Операция не поддерживается для этого типа объекта" в команде rs.MoveFirst.

Если я закомментирую это, прочитав, что это по умолчанию и не нужно, я получу "Не удалось установить свойство списка. Несовпадение типов" при добавлении элемента.List, но не первого, после нескольких итераций.

Нужно ли использовать другую команду набора записей? Я предполагаю, что ошибка свойства списка связана с неправильным достижением конца списка из-за неправильного запуска?

Любая помощь приветствуется!

    Sub Populate_Combo_Boxes()
        On Error GoTo Err_Handler

        Dim cnn As ADODB.Connection
        Set cnn = New ADODB.Connection

        Dim rs As New ADODB.Recordset
        Set rs = New ADODB.Recordset


        cnn.Mode = adModeRead
        cnn.Open ConString

        c = 0

            'Pull Agent Listing
            rs.Open "SELECT Personnel.AgentID, Personnel.Agent " & _
                    "FROM Personnel " & _
                    "WHERE (Personnel.TermDate is Null or Personnel.TermDate <= Personnel.HireDate) ORDER BY Personnel.Agent;", _
                    cnn, adOpenForwardOnly, adLockReadOnly
            rs.MoveFirst

            With frmSubmit.cmbAgent
                .ColumnCount = 2
                .BoundColumn = 1
                .ColumnWidths = "160 pt; 0 pt"
                .Clear

                Do
                    .AddItem
                    .List(c, 0) = rs!Agent
                    .List(c, 1) = rs!AgentID 'this field is hidden
                    rs.MoveNext
                    c = c + 1
                Loop Until rs.EOF

            End With

    Exit_Handler:
            If Not (rs Is Nothing) Then
          If (rs2.State And adStateOpen) = adStateOpen Then rs2.Close
          Set rs2 = Nothing
        End If
        If Not (cnn Is Nothing) Then
          If (cnn.State And adStateOpen) = adStateOpen Then cnn.Close
          Set cnn = Nothing
        End If
        Exit Sub

    Err_Handler:
        MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error!"
        Resume Exit_Handler
    End Sub

0 ответов

Другие вопросы по тегам