The code is composed of 4 functions:
ClearListBox() – Clears a list box. It uses a For Next loop and the list box ListCount property to set the Selected property for each item to False.
SelectAllListBox() – Selects all the items in a list box. It uses a For Next loop and the list box ListCount property to set the Selected property for each item to True.
FillList() – Fills a list box with values parsed from a comma+space delimited string. It uses Split() to change the string to an array. Then it uses a For Next loop to work through the array values and compare them to each item value in the list box. If a match is found, it sets the Selected value of item to True.
BuildDelimList() – Passes back a string of comma+space delimited values from selected values in a list box. It uses the ItemsSelected collection of the list, combined with the ItemData collection, to concatenate the selected item values together.
The Microsoft Access example is called ListBox Example.mdb. The functions are located in the code module named basListBox. When the example opens, the Select Patio form appears. The left side of the form contains the list box, which uses the Patio table for a record source. The right side of form contains the text box value, from the Data table, created by selecting values from the list. View the form code module to see the event code that drives the results.
' basListBox Version 1.0.0 ' Copyright © 2009 Extra Mile Data, www.extramiledata.com. ' For questions or issues, please contact [email protected] ' Use (at your own risk) and modify freely as long as proper credit is given. Public Sub ClearListBox(ListCtl As ListBox) ' This procedure clears the ListCtl list box. On Error GoTo Err_ClearListBox Dim intCount As Integer ' For each item in the list, deselect it. For intCount = 0 To ListCtl.ListCount ListCtl.Selected(intCount) = False Next intCount ' Put the cursor back at the top of the list. ListCtl.Selected(0) = False Exit_ClearListBox: On Error Resume Next Exit Sub Err_ClearListBox: MsgBox Err.Number & " " & Err.Description, vbCritical, "ClearListBox" Resume Exit_ClearListBox End Sub Public Sub SelectAllListBox(ListCtl As ListBox) ' This procedure selects all the items in the ListCtl list box. On Error GoTo Err_SelectAllListBox Dim intCount As Integer ' For each item in the list, select it. For intCount = 0 To ListCtl.ListCount ListCtl.Selected(intCount) = True Next intCount Exit_SelectAllListBox: On Error Resume Next Exit Sub Err_SelectAllListBox: MsgBox Err.Number & " " & Err.Description, vbCritical, "SelectAllListBox" Resume Exit_SelectAllListBox End Sub Public Sub FillList(ListCtl As ListBox, DelimList) ' This procedure fills the ListCtl list box with values parsed from ' a comma+space delimited string of values found in DelimList. On Error GoTo Err_FillList Dim blnFound As Boolean Dim strValue As String Dim intCount As Integer Dim intListItemsCount As Integer Dim avarDelim ' If there is no list to parse, just exit. If IsNull(DelimList) Then GoTo Exit_FillList End If ' Create an array of values from DelimList. avarDelim = Split(DelimList, ", ") ' Initialize some other variables. intCount = 0 ' Clear the list box selections. ClearListBox ListCtl For intCount = 0 To UBound(avarDelim) ' Get the array value. strValue = avarDelim(intCount) ' Initialize the "found" variable and the list item count. blnFound = False intListItemsCount = 0 ' Keep looping through the list items until a match with the array ' value is found or until there are no more items in the list to ' compare to. Do ' Compare the array value to the list value. If StrComp(Trim(ListCtl.ItemData(intListItemsCount)), Trim(strValue)) = 0 Then ' If they are a match, then select the item in the list box ' and flag that one has been found. ListCtl.Selected(intListItemsCount) = True blnFound = True End If ' Increment the list item count. intListItemsCount = intListItemsCount + 1 Loop Until blnFound = True Or intListItemsCount = ListCtl.ListCount Next intCount Exit_FillList: On Error Resume Next Exit Sub Err_FillList: MsgBox Err.Number & " " & Err.Description, vbCritical, "FillList" Resume Exit_FillList Resume End Sub Public Function BuildDelimList(ListCtl As ListBox) As Variant ' This function passes back a string of comma+space delimited values from ' the ListCtl list box. If there are no selected values in ListCtl, ' it passes back a null. On Error GoTo Err_BuildDelimList Dim objItem As Variant Dim strTemp As String Dim intCount As Integer ' Initialize the variable that lets us know whether or not we are ' at the first item in the list box. intCount = 0 ' Initialize the variable that will hold the delimited list. strTemp = "" ' Only proceed if there are items in the list box. If ListCtl.ItemsSelected.Count > 0 Then For Each objItem In ListCtl.ItemsSelected ' For each item that is selected, add it to the delimited list. ' The first one does not need a comma in front of it. If intCount = 0 Then strTemp = strTemp & ListCtl.ItemData(objItem) intCount = intCount + 1 Else strTemp = strTemp & ", " & ListCtl.ItemData(objItem) intCount = intCount + 1 End If Next objItem BuildDelimList = strTemp Else BuildDelimList = Null End If Exit_BuildDelimList: On Error Resume Next Exit Function Err_BuildDelimList: MsgBox Err.Number & " " & Err.Description, vbCritical, "BuildDelimList" BuildDelimList = False Resume Exit_BuildDelimList End Function