sql - 将数据从 MS Access 导出到 MS Excel 列表框

Question

我有一个有效的 VBA 代码，它从 MS Access 数据中导出数据并将其粘贴到 MS Excel 工作表单元格中，并使用单元格范围作为 RowSource 以在 ListBox 中显示数据。

有没有办法将导入的数据直接粘贴到 ListBox 而不是粘贴到 Sheet 单元格中？

Sub IBDocsLibSearch()

    Dim cnn As ADODB.Connection 'dim the ADO collection class
    Dim rs As ADODB.Recordset 'dim the ADO recorset class
    Dim dbPath As String
    Dim MyDbPassword As String
    Dim SQL As String
    Dim i As Integer
    Dim var1

    Application.ScreenUpdating = False

    IBDocLibSheet.Range("A2:I500000").ClearContents

    dbPath = LinkSheet.Range("C4").Value 'Inbound Checklist Database Location
    MyDbPassword = PWSheet.Range("C3").Value 'Password to connect the Excel to Access

    Set var1 = IBUserForm.IBDTextSerialNo 

    'Initialise the collection class variable
    Set cnn = New ADODB.Connection

    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath & ";Jet OLEDB:Database Password=" & MyDbPassword

    SQL = "SELECT * FROM DB_IBDocuments WHERE SerialNo = '" & var1.Value & "'"

    Set rs = New ADODB.Recordset 

    rs.Open SQL, cnn

    If rs.EOF And rs.BOF Then
        'Close the recordset and connection
        rs.Close
        cnn.Close
        'Clear Memory
        Set rs = Nothing
        Set cnn = Nothing
    Application.ScreenUpdating = True
    Exit Sub
    End If

    IBDocLibSheet.Range("A2").CopyFromRecordset rs '----This is where to paste the extracted data

    'To show results in Listbox
    IBUserForm.IBDListBox.RowSource = "IBL_DocLib"

    'Close the recorset and connections
    rs.Close
    cnn.Close
    'Clear memory
    Set rs = Nothing
    Set cnn = Nothing

    Application.ScreenUpdating = True
End Sub

标签： sqlexcelvbams-access