How to bind data from a recordset to a combobox?

wayne62682 · April 1st, 2006, 11:32 AM

For my application I need to take data from my database and display it in a combobox/dropdown to use. I have created a seperate class with a function that returns an ADODB.Recordset with the data I need. However, as I'm still learning VBA I don't know how to bind this to the combobox on my form.

Here is the code for the form_load event (note that I don't have any code to bind to the combobox yet since I don't know what the correct usage is; the ones I have tried already didn't work [see below]):

Code:

    ' Get the current user and access level
    ' TODO:  Add code to turn on/off functionality based on access level
    lblCurrentUser.Caption = "Logged in as: " & User.CurrentUser

    Dim r As Resident
    Set r = New Resident

    Dim rsResident As ADODB.Recordset
    Set rsResident = r.GetResidentList

    ' Set ComboBox to display list of residents
    With cboSelectResident
        ' TODO: Add code to bind recordset's FirstName
        ' and LastName to the text of the combobox
        ' and bind ResidentID to the value
        ' for use on the form
    End With

Now, here is the GetResidentList function from my "Resident" class:

Code:

Public Function GetResidentList() As ADODB.Recordset
    Dim conn As ADODB.Connection
    Set conn = New ADODB.Connection

    conn.Open DbConnectionString

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

    With rs
        .CursorLocation = adUseClient
        .CursorType = adOpenForwardOnly
        .LockType = adLockReadOnly
        .Open "SELECT ResidentID, FirstName, LastName FROM tblResident", conn
    End With

    If rs.BOF And rs.EOF Then
        Exit Function
    End If

    ' CLEANUP
    conn.Close
    Set rs.ActiveConnection = Nothing
    Set conn = Nothing

    Set GetResidentList = rs

End Function

I have tried setting the combobox's .Recordset property to rsResident, the text property to rsResident!LastName and the value to rsResident!ResidentID, but this gives me an "Object variable or With block variable not set" error, with the flagged code being .Recordset = rsResident. I tried setting it to

Code:

Set cboSelectResident.Recordset = rsResident

outside of the With..End With block but this gives me an "The object you entered is not a valid Recordset property" error.

Any idea what I am forgetting to add in order to make this work? I need the combobox to display the person's name and pass as its value the ResidentID (for use populating other controls on the form).

Much appreciated.

Bob Bedell · April 1st, 2006, 07:17 PM

Hello,

Here's how you might do it using the combobox's AddItem method. Can't remember if support for the AddItem method was added to version 2K or 2K2, but if you are using a version that doesn't support it let me know and we'll try the user-defined function route to build the Value List string. Also, I believe an Access combobox can only display a single field value. So if you want to display the first name and last name, I believe you'll need to concatenate them.

Code:

Private Sub Form_Open(Cancel As Integer)
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim strSQL As String

    strSQL = "SELECT ID, FirstName, LastName FROM Table1 " _

    Set cnn = CurrentProject.Connection

    Set rst = New ADODB.Recordset
    rst.Open strSQL, cnn, adOpenForwardOnly, adLockReadOnly

    ' Configure combobox properties
    With cboRecordset
        .RowSourceType = "Value List"
        .BoundColumn = 1
        .ColumnCount = 2
        .ColumnWidths = "0;1in"
    End With

    ' Load combo box with recordset values.
    With rst
        .MoveFirst
        Do Until .EOF
            ' The semi-colon in the string indicates a column break. The ID
            ' field is your BoundColumn, the concatenated last/first names
            ' are displayed. You CAN'T use a comma or semi-colon in place of
            ' the dash.
            cboRecordset.AddItem !ID & ";" & !LastName & " - " & !FirstName
            .MoveNext
        Loop
    End With

    ' Ensure first item in Value List is displayed.
    With cboRecordset
        .DefaultValue = .ItemData(0)
    End With

    rst.Close

    Set rst = Nothing
    Set cnn = Nothing
End Sub

HTH,

Bob

wayne62682 · April 1st, 2006, 09:58 PM

Hmm.. so it's not possible under VBA to use a Recordset returned from another function? What you posted worked, thank you, but I thought it would be more efficient to do the connection/recordset work from my "Resident" class and then call it from my the form code. It's not a big deal, just trying to get in the habit of good programming :)

Bob Bedell · April 1st, 2006, 10:34 PM

Quote:

quote:
Hmm.. so it's not possible under VBA to use a Recordset returned from another function?

Sure it is. Your post indicated that you already had the class written, so I didn't bother writing it.

' ==================================
' clsSelectData
' ==================================

Public Function GetRecordset(ByRef objConnection As ADODB.Connection) As ADODB.Recordset

    On Error GoTo Err_Handler

    Dim cmd As New ADODB.Command

    cmd.CommandText = "SELECT ID, FirstName, LastName FROM Table1"
    cmd.CommandType = adCmdText

    cmd.ActiveConnection = objConnection
    Set GetRecordset = cmd.Execute

    Set cmd = Nothing

    Exit Function

Exit_Here:
   On Error Resume Next
   Exit Function

Err_Handler:
   Err.Raise Err.Number, "clsSelectData::GetRecordset", Err.Description
   Resume Exit_Here

End Function

' ==================================
' Form1
' ==================================

Private Sub Form_Load()
    On Error GoTo ErrorHandler

    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Set cnn = CurrentProject.Connection

    ' ================================
    ' Instantiate clsSelectData object
    ' ================================
    Dim objSelectData As clsSelectData
    Set objSelectData = New clsSelectData

    ' ================================
    ' Get your recordset
    ' ================================
    Set rst = objSelectData.GetRecordset(cnn)

    ' Configure combobox properties
    With cboRecordset
        .RowSourceType = "Value List"
        .BoundColumn = 1
        .ColumnCount = 2
        .ColumnWidths = "0;1in"
    End With

    ' Load combo box with recordset values.
    With rst
        .MoveFirst
        Do Until .EOF
            ' The semi-colon in the string indicates a column break. The ID
            ' field is your BouondColumn, the concatenated last/first names
            ' are displayed. You CAN'T use a comma or semi-colon in place of
            ' the dash.
            cboRecordset.AddItem !id & ";" & !LastName & " - " & !FirstName
            .MoveNext
        Loop
    End With

    ' Ensure first item in Value List is displayed.
    With cboRecordset
        .DefaultValue = .ItemData(0)
    End With

    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing

ErrorHandler:
    If Not rst Is Nothing Then
        If rst.State = adStateOpen Then rst.Close
    End If
    Set rst = Nothing

    If Not cnn Is Nothing Then
        If cnn.State = adStateOpen Then cnn.Close
    End If
    Set cnn = Nothing

    If Err <> 0 Then
        MsgBox Err.Source & " - " & Err.Description, , "Error"
    End If
End Sub

HTH,

Bob

Bob Bedell · April 1st, 2006, 11:56 PM

Or if you want really efficient recordset/connection management:

' ============================================
' Global variables declared in standard module
' ============================================
Global g_cnn As ADODB.connection
Global g_rst As ADODB.Recordset

' ============================================
' Saved query: qrySelectPeople
' ============================================
SELECT ID, tblPeople.FirstName, tblPeople.LastName
FROM tblPeople;

' ============================================
' clsSelectData
' ============================================

Public Function GetRecordset(ByRef cnn As ADODB.connection, _
                              ByRef rst As ADODB.Recordset)

    On Error GoTo Err_Handler

    rst.CursorLocation = adUseClient
    rst.Open "qrySelectPeople", cnn, adOpenForwardOnly, adLockReadOnly, adCmdStoredProc

Exit_Here:
    On Error Resume Next
    Exit Function

Err_Handler:
    Err.Raise Err.Number, "clsSelectData::GetRecordset", Err.Description
    Resume Exit_Here

End Function

' ===============================================
' Your combobox form
' ===============================================

    On Error GoTo Err_Handler

    ' =====================================
    ' Declare clsSelectData object variable
    ' =====================================
    Dim objSelectData As clsSelectData

    On Error GoTo Err_Handler

    ' =====================================
    ' Open connection and instantiate
    ' clsSelectData object
    ' =====================================
    If OpenADOConnection(g_cnn) Then
        Set g_rst = New ADODB.Recordset
        If objSelectData Is Nothing Then
            Set objSelectData = New clsSelectData
        End If

        ' =====================================
        ' Load global recordset object
        ' =====================================
        Call objSelectData.GetRecordset(g_cnn, g_rst)

        ' =====================================
        ' Disconnect global recordset object
        ' and close global connection
        ' =====================================
        Call DisconnectADORecordset(g_rst, g_cnn)

    End If

    ' Configure combobox properties
    With cboRecordset
        .RowSourceType = "Value List"
        .BoundColumn = 1
        .ColumnCount = 2
        .ColumnWidths = "0;1in"
    End With

    ' Load combo box with recordset values.
    With g_rst
        .MoveFirst
        Do Until .EOF
            ' The semi-colon in the string indicates a column break. The ID
            ' field is your BouondColumn, the concatenated last/first names
            ' are displayed. You CAN'T use a comma or semi-colon in place of
            ' the dash.
            cboRecordset.AddItem !id & ";" & !LastName & " - " & !FirstName
            .MoveNext
        Loop
    End With

    ' Ensure first item in Value List is displayed.
    With cboRecordset
        .DefaultValue = .ItemData(0)
    End With

     ' =====================================
     ' Close global recordset object
     ' =====================================
    Call CloseADORecordset(g_rst)
    Set objSelectData = Nothing

Exit_Here:
    On Error Resume Next
    Call CloseADORecordset(g_rst)
    Set objSelectData = Nothing
    Exit Sub

Err_Handler:

    Dim strErrorMessage As String
    strErrorMessage = "An error has occured in " & _
                  Err.Source & "." & vbCrLf & vbCrLf
    strErrorMessage = strErrorMessage & "Error Number: " & Trim(Str(Err.Number)) & vbCrLf _
                            & "Error Description: " & Err.Description

    MsgBox Prompt:=strErrorMessage, _
           Buttons:=vbCritical, _
           Title:="Error Report"

    Resume Exit_Here

End Sub

' ============================================
' basADOFunctions
' ============================================
' My ADO recordset and connection management
' routines for maintaining client-side,
' disconnected recordsets. Place this module
' in a .mda file (Access library database) and
' reference the .mda in your current application.
' ============================================

'================================================= ====================
' OpenADOConnection
' --------------------------
' Opens an ADO connection object.
'
' Parameter Use
' ------------------------------------------------
' cnn An ADO connection object.
'
' Returns
' -------
' True if conncetion opend successfully.
' False ifi connection failed to open.
'================================================= ====================
Public Function OpenADOConnection(ByRef cnn As ADODB.connection) As Boolean

    Dim blnState As Boolean

    On Error GoTo Err_Handler

    If cnn Is Nothing Then
        Set cnn = New ADODB.connection
    End If

    If cnn.State = adStateOpen Then
        blnState = True
    Else
        cnn.ConnectionString = "File Name=C:\JetBackendDB.UDL"
        cnn.Open
        If cnn.State = adStateOpen Then
            blnState = True
        Else
            blnState = False
        End If
    End If

    OpenADOConnection = blnState

Exit_Here:
    On Error Resume Next
    Exit Function

Err_Handler:

    Dim strErrorMessage As String
    strErrorMessage = "An error has occured in " & _
                  Application.CurrentObjectName & "." & vbCrLf & vbCrLf
    strErrorMessage = strErrorMessage & "Error Number: " & Trim(Str(Err.Number)) & vbCrLf _
                            & "Error Description: " & Err.Description

    MsgBox Prompt:=strErrorMessage, _
           Buttons:=vbCritical, _
           Title:="Error Report"

    Resume Exit_Here

End Function

'================================================= ====================
' CloseADOConnection
' --------------------------
' Closes an ADO connection object.
'
' Parameter Use
' ------------------------------------------------
' cnn Connection object to close.
'
' Returns
' -------
' None
'================================================= ====================
Public Sub CloseADOConnection(ByRef cnn As ADODB.connection)

    On Error GoTo Err_Handler

    If Not cnn Is Nothing Then
        If cnn.State = adStateOpen Then
            cnn.Close
            Set cnn = Nothing
        Else
            Set cnn = Nothing
        End If
    End If

Exit_Here:
    On Error Resume Next
    Exit Sub

Err_Handler:

    Dim strErrorMessage As String
    strErrorMessage = "An error has occured in " & _
                  Application.CurrentObjectName & "." & vbCrLf & vbCrLf
    strErrorMessage = strErrorMessage & "Error Number: " & Trim(Str(Err.Number)) & vbCrLf _
                            & "Error Description: " & Err.Description

    MsgBox Prompt:=strErrorMessage, _
           Buttons:=vbCritical, _
           Title:="Error Report"

    Resume Exit_Here

End Sub

'================================================= ====================
' OpenADORecordset
' --------------------------
' Opens an ADO Recrodset object.
'
' Parameter Use
' ------------------------------------------------
' rst Ado recordset object to to open.
' cnn ADO connection object to use as recordsets
' ActiveConnction parameter.
' strSource Expression to use as recordsets Source
' Parameter.
' lngCommandType A CommandTypeEnum value.
'
' Returns
' -------
' True if recordset opend successfully.
' False if recordset failed to open.
'================================================= ====================
Public Function OpenADORecordset(ByRef rst As ADODB.Recordset, _
                                 ByRef cnn As ADODB.connection, _
                                 ByVal strSource As String, _
                                 ByVal lngCommandType As CommandTypeEnum) As Boolean

    Dim blnState As Boolean

    On Error GoTo Err_Handler

    If rst Is Nothing Then
        Set rst = New ADODB.Recordset
    End If

    If rst.State = adStateOpen Then
        blnState = True
    Else
        rst.CursorLocation = adUseClient
        rst.Open Source:=strSource, _
             ActiveConnection:=cnn, _
             CursorType:=adOpenStatic, _
             LockType:=adLockReadOnly, _
             Options:=lngCommandType
        If cnn.State = adStateOpen Then
            blnState = True
            Set rst.ActiveConnection = Nothing
        Else
            blnState = False
        End If
    End If

    Call CloseADOConnection(cnn)

    OpenADORecordset = blnState

Exit_Here:
    On Error Resume Next
    Exit Function

Err_Handler:

    Dim strErrorMessage As String
    strErrorMessage = "An error has occured in " & _
                  Application.CurrentObjectName & "." & vbCrLf & vbCrLf
    strErrorMessage = strErrorMessage & "Error Number: " & Trim(Str(Err.Number)) & vbCrLf _
                            & "Error Description: " & Err.Description

    MsgBox Prompt:=strErrorMessage, _
           Buttons:=vbCritical, _
           Title:="Error Report"

    Resume Exit_Here

End Function

'================================================= ====================
' CloseADORecordset
' --------------------------
' Closes an ADO recordset object.
'
' Parameter Use
' ------------------------------------------------
' rst Recordset object to close.
'
' Returns
' -------
' None
'================================================= ====================
Public Sub CloseADORecordset(ByRef rst As ADODB.Recordset)

    On Error GoTo Err_Handler

    If Not rst Is Nothing Then
        If rst.State = adStateOpen Then
            rst.Close
            Set rst = Nothing
        Else
            Set rst = Nothing
        End If
    End If

Exit_Here:
    On Error Resume Next
    Exit Sub

Err_Handler:

    Dim strErrorMessage As String
    strErrorMessage = "An error has occured in " & _
                  Application.CurrentObjectName & "." & vbCrLf & vbCrLf
    strErrorMessage = strErrorMessage & "Error Number: " & Trim(Str(Err.Number)) & vbCrLf _
                            & "Error Description: " & Err.Description

    MsgBox Prompt:=strErrorMessage, _
           Buttons:=vbCritical, _
           Title:="Error Report"

    Resume Exit_Here

End Sub

'================================================= ====================
' DisconnectADORecordset
' --------------------------
' Disconnect an ADO recordset object.
'
' Parameter Use
' ------------------------------------------------
' rst Recordset object to disconnect.
'
' Returns
' -------
' None
'================================================= ====================
Public Sub DisconnectADORecordset(ByRef rst As ADODB.Recordset, _
                                  ByRef cnn As ADODB.connection)

    On Error GoTo Err_Handler

    If Not rst Is Nothing Then
        If rst.State = adStateOpen Then
            Set rst.ActiveConnection = Nothing
        End If
    End If

    Call CloseADOConnection(cnn)

Exit_Here:
    On Error Resume Next
    Exit Sub

Err_Handler:

    Dim strErrorMessage As String
    strErrorMessage = "An error has occured in " & _
                  Application.CurrentObjectName & "." & vbCrLf & vbCrLf
    strErrorMessage = strErrorMessage & "Error Number: " & Trim(Str(Err.Number)) & vbCrLf _
                            & "Error Description: " & Err.Description

    MsgBox Prompt:=strErrorMessage, _
           Buttons:=vbCritical, _
           Title:="Error Report"

    Resume Exit_Here

End Sub

Bob

wayne62682 · April 2nd, 2006, 08:30 AM

Thank you very much for your help. That works perfectly for my needs (the second to last one... not quite in need of THAT an efficient use of recordsets :) ). I am still learning Access VBA so it's a change from the VB.NET/C# that I'm used to. Thanks again.

Bob Bedell · April 2nd, 2006, 08:45 PM

You're welcome wayne. :) Thanks for the topic.

Bob