Using a recordset to populate a combo or list box in an excel userform

[snowmantle]

Hi I have got the below code, I want a function that passes the values to my list box or combo box on a user form. I didnt like the idea of passing a recordset so i put it in an array.. problem is how do i reuse it as an array to populate the listbox?? the below doesnt work

Function GetWarehouses() As Variant
'getting the warehouse list out of the database for use in the user form drop down list
'if no records are found then the function returns null
    Dim conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim myDB As String
    Dim sqlStr As String
    Dim i As Integer
    Dim iRows As Integer
    
    myDB = ThisWorkbook.path & "\" & DBNAME
    Set conn = New ADODB.Connection
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & myDB & ";"

    sqlStr = "SELECT [warehouse_key], UCASE([warehouse_name]) FROM [Warehouses] ORDER BY [warehouse_name]"
    
    Set rs = New ADODB.Recordset
    rs.Open sqlStr, conn, adOpenStatic, adLockReadOnly
    
    iRows = rs.RecordCount
    If iRows > 0 Then
        'creating array, its dimensions are zero based
        'ReDim is used to create a dynamic array by passing in a variable for its size
        'this can't be done without doing a ReDim
        Dim warehouses() As Variant
        ReDim warehouses(rs.RecordCount - 1, 1)
        i = 0
        Do While Not rs.EOF
            warehouses(i, 0) = CStr(rs.Fields(0))
            warehouses(i, 1) = CStr(rs.Fields(1))
            rs.MoveNext
            i = i + 1
        Loop
        MsgBox IsArray(warehouses)
        GetWarehouses = warehouses
    End If
        
    GetWarehouses = Null
    
    rs.Close
    conn.Close
    rs = Nothing
    conn = Nothing
    
End Function


'UserForm Code

Private Sub UserForm_Initialize()
    'needs brackets to keep this as an array
    Dim warehouses
    Dim i As Integer

    warehouses = DbaseMod.GetWarehouses()
    
    'MsgBox IsArray(DbaseMod.GetWarehouses())
    MsgBox IsArray(warehouses)
    
    If Not warehouses Is Null Then
        ListBox1.ColumnCount = 2
        ListBox1.List() = warehouses
'        For i = 0 To UBound(warehouses)
'            CBWarehouses.AddItem warehouses(i, 1), warehouses(i, 0)
'        Next
    End If

End Sub

 

[PHV]

I'd comment out this line:
GetWarehouses = Null

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[snowmantle]

Made a slight alteration to the function, I can see my error in not placing the GetWarehouses = null inside the else clause of the if statement.

I wanted to return null if the recordset is empty is there a better way to be doing this? passing an empty array instead as the result of the function?

This didnt fix the problem I am getting an error of "Object required".. The list box is there and has the correct name.

The error seems to occur after the GetWarehouses function has run, the function itself runs fine on its own.. only becomes a problem when trying to use it when initialising the user form.

Function GetWarehouses() As Variant
'getting the warehouse list out of the database for use in the user form drop down list
'if no records are found then the function returns null
    Dim conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim myDB As String
    Dim sqlStr As String
    Dim i As Integer
    Dim iRows As Integer
    
    myDB = ThisWorkbook.path & "\" & DBNAME
    Set conn = New ADODB.Connection
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & myDB & ";"

    sqlStr = "SELECT [warehouse_key], UCASE([warehouse_name]) FROM [Warehouses] ORDER BY [warehouse_name]"
    
    Set rs = New ADODB.Recordset
    rs.Open sqlStr, conn, adOpenStatic, adLockReadOnly
    
    iRows = rs.RecordCount
    If iRows > 0 Then
        'creating array, its dimensions are zero based
        'ReDim is used to create a dynamic array by passing in a variable for its size
        'this can't be done without doing a ReDim
        Dim warehouses() As Variant
        ReDim warehouses(iRows - 1, 1)
        i = 0
        Do While Not rs.EOF
            warehouses(i, 0) = CStr(rs.Fields(0))
            warehouses(i, 1) = CStr(rs.Fields(1))
            rs.MoveNext
            i = i + 1
        Loop
        MsgBox IsArray(warehouses)
        GetWarehouses = warehouses
    Else
        GetWarehouses = Null
    End If

    rs.Close
    conn.Close
    Set rs = Nothing
    Set conn = Nothing
    
End Function

 

[snowmantle]

Sorted it now, thanks for the help in the right direction

Function GetWarehouses() As Variant
'getting the warehouse list out of the database for use in the user form drop down list
'if no records are found then the function returns null
    Dim conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim myDB As String
    Dim sqlStr As String
    Dim i As Integer
    Dim iRows As Integer
    Dim warehouses() 'array
    
    myDB = ThisWorkbook.path & "\" & DBNAME
    Set conn = New ADODB.Connection
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & myDB & ";"

    sqlStr = "SELECT [warehouse_key], UCASE([warehouse_name]) FROM [Warehouses] ORDER BY [warehouse_name]"
    
    Set rs = New ADODB.Recordset
    rs.Open sqlStr, conn, adOpenStatic, adLockReadOnly
    
    iRows = rs.RecordCount
    If iRows > 0 Then
        'creating array, its dimensions are zero based
        'ReDim is used to create a dynamic array by passing in a variable for its size
        'this can't be done without doing a ReDim
        ReDim warehouses(iRows - 1, 1)
        i = 0
        Do While Not rs.EOF
            warehouses(i, 0) = CStr(rs.Fields(0))
            warehouses(i, 1) = CStr(rs.Fields(1))
            rs.MoveNext
            i = i + 1
        Loop
    End If
    
    rs.Close
    conn.Close
    Set rs = Nothing
    Set conn = Nothing

    GetWarehouses = warehouses
    
End Function




'User form code

Private Sub UserForm_Initialize()
    'needs brackets to keep this as an array
    Dim warehouses()
    Dim i As Integer

    warehouses = DbaseMod.GetWarehouses()
    
    If UBound(warehouses) > 0 Then
        ListBox1.ColumnCount = 2
        ListBox1.List() = warehouses
'        For i = 0 To UBound(warehouses)
'            CBWarehouses.AddItem warehouses(i, 1), warehouses(i, 0)
'        Next
    End If

End Sub

 

[snowmantle]

No sorry its not entirely fixed because I will get a subscript out of range error when using Ubound on an array that has not got its dimensions set..

Silly me.. Stuck again now.

 

[snowmantle]

Ok think its sorted now.

Changed the userform code so the if statement does the below

    If Not IsEmpty(warehouses) Then

 

[snowmantle]

Oh and also changing the warehouses variant variable so that it is declared as Dim warehouses As Variant.. without the brackets.. because it only saw it as an empty variant that way.

Sorry that will be my last comment on the matter.
Just replying in case it helps anyone.