Populate excel listbox with database table

[Don Quixote]

Hi, I am trying to make an excel userform that connects to an access database. So far I can search and create new database entries from withing excel.

But I can't seem to populate my listbox with a selection of my database table.

Here is my code for initializing the userform and fill the listbox:

Private Sub UserForm_Initialize()

    Dim con As Object
    Dim rs As Object
    Set con = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")

    txtBestelbon.BackColor = RGB(255, 150, 224)
    txtTransporteur.BackColor = RGB(255, 150, 224)
    txtProduct.BackColor = RGB(255, 150, 224)
    txtLosplaats.BackColor = RGB(255, 150, 224)
    txtTank.BackColor = RGB(255, 150, 224)
    
    con.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\Dennis\Documents\Blending & Filling\Basis Olie Lossing\Base Oils.accdb;"
    con.Open
    Set rs.ActiveConnection = con
    
    rs.Open "SELECT [Bestelbon], [Productnaam] FROM [Planning]"
    'rs.Open "[Planning]"
    
    'rs.MoveFirst
    'ListBox1.RowSourceType = "Table/Query"
    'ListBox1.RowSource = rs
    'ListBox1.AddItem rs.Fields(3)
    'ListBox1.AddItem "SELECT [Bestelbon], [Productnaam] FROM [Planning]"
    'ListBox1.AddItem.List(0, 1) = rs![Product naam]
    ListBox1.ColumnCount = 2
    ListBox1.ColumnWidths = "100;100"
    'ListBox1.ListIndex = 1
    'ListBox1.ColumnHeads = True
    
End Sub

If you need more info please ask. I've commented out several lines of code that don't seem to work.
This is my first time working with vba and I've gotten pretty far along for someone with no real coding skills, but right now
I've hit a brick wall.

Any help would be much appreciated.

 

[MikeVol]

Hello @Don Quixote.
Try next code:

Private Sub UserForm_Initialize()
    Dim i           As Long
    On Error GoTo Whoa
    Application.ScreenUpdating = False

    TextBox1.BackColor = RGB(255, 150, 224)
    TextBox2.BackColor = RGB(255, 150, 224)
    TextBox3.BackColor = RGB(255, 150, 224)
    TextBox4.BackColor = RGB(255, 150, 224)
    TextBox5.BackColor = RGB(255, 150, 224)

    Dim dbPath      As String
    dbPath = "C:\Users\Mike\Documents\DB_Copy.accdb"   ' Replace with your path to the .accdb file

    Dim cnn         As ADODB.Connection
    Set cnn = New ADODB.Connection
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath

    Dim SQL         As String
    SQL = "SELECT * FROM Planning "

    Dim rst         As ADODB.Recordset
    Set rst = New ADODB.Recordset
    rst.Open SQL, cnn

    If rst.EOF And rst.BOF Then
        rst.Close
        cnn.Close
        Set rst = Nothing
        Set cnn = Nothing
        Application.ScreenUpdating = True

        MsgBox "There are no records in the recordset!", vbCritical, "No Records"
        Exit Sub
    End If

    rst.MoveFirst
    i = 0

    With Me.ListBox1
        .ColumnWidths = "100;100"
        .ColumnCount = rst.Fields.Count
        .Column = rst.GetRows
    End With

    Application.ScreenUpdating = True
LetsContinue:
    Application.ScreenUpdating = True
    On Error Resume Next
    rst.Close
    Set rst = Nothing
    cnn.Close
    Set cnn = Nothing
    On Error GoTo 0
    Exit Sub
Whoa:
    MsgBox "Error Description  :" & Err.Description & vbCrLf & _
            "Error at line     :" & Erl & vbCrLf & _
            "Error Number      :" & Err.Number
    Resume LetsContinue
End Sub

The Library in the reference must also be connected, see the screenshot below. Good luck.

 

[Don Quixote]

It worked, thx a lot

 

[Don Quixote]

Do you perhaps know how to set the field names as column headers in the listbox?

 

[MikeVol]

Ok, try other option.

Private Sub UserForm_Initialize()
    Dim i As Long, j As Long
    Dim ctrl        As Control
    On Error GoTo Whoa
    Application.ScreenUpdating = False

    For Each ctrl In Me.Controls
        If TypeName(ctrl) = "TextBox" Then ctrl.BackColor = RGB(255, 150, 224)
    Next ctrl

    Dim dbPath      As String
    dbPath = "C:\Users\Mike\Documents\DB_Copy.accdb"   ' Replace with your path to the .accdb file

    Dim cnn         As ADODB.Connection
    Set cnn = New ADODB.Connection
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath

    Dim SQL         As String
    SQL = "SELECT * FROM Planning"

    Dim rst         As ADODB.Recordset
    Set rst = New ADODB.Recordset
    rst.Open SQL, cnn, adOpenStatic, adLockReadOnly

    If rst.EOF And rst.BOF Then
        rst.Close
        cnn.Close
        Set rst = Nothing
        Set cnn = Nothing
        Application.ScreenUpdating = True
        MsgBox "There are no records in the recordset!", vbCritical, "No Records"
        Exit Sub
    End If

    Dim fieldCount  As Long
    fieldCount = rst.Fields.Count

    Dim headers()   As String
    ReDim headers(fieldCount - 1)

    For i = 0 To fieldCount - 1
        headers(i) = rst.Fields(i).Name
    Next i

    Dim records     As Variant
    records = rst.GetRows

    Dim rowCount    As Long
    rowCount = UBound(records, 2) + 1
    
    Dim finalData() As Variant
    ReDim finalData(0 To fieldCount - 1, 0 To rowCount)

    For i = 0 To fieldCount - 1
        finalData(i, 0) = headers(i)
    Next i

    For i = 0 To fieldCount - 1

        For j = 1 To rowCount
            finalData(i, j) = records(i, j - 1)
        Next j

    Next i

    With Me.ListBox1
        .ColumnCount = fieldCount
        .ColumnWidths = "100;100"    ' Change to suit your data
        .List = Application.Transpose(finalData)
    End With

LetsContinue:
    rst.Close
    Set rst = Nothing
    cnn.Close
    Set cnn = Nothing
    Application.ScreenUpdating = True
    Exit Sub

Whoa:
    MsgBox "Error Description  :" & Err.Description & vbCrLf & _
            "Error at line     :" & Erl & vbCrLf & _
            "Error Number      :" & Err.Number
    Resume LetsContinue
End Sub

 

[Don Quixote]

it seems to work