ConcatenateFieldValues
This function is based a function named "Concatenate" that was originally written by Duane Hookom (ACCESS MVP); he has a sample database that contains the function. It is used to create a concatenated string from a single field's values from all the records desired to be included in the concatenated string. The records to be included, plus the field to be used for creating the concatenated string, are specified by an SQL statement that is passed to the function. The SQL statement passed to the function must return only one field in order for this function to work correctly. The values in the concatenated string are separated by a character string that is provided to the function as a delimiter string (if no delimiter is provided, the function uses a comma followed by a space).
Public Function ConcatenateFieldValues(pstrSQL As String, _
Optional pstrDelim As String = ", ") As String
' Created by Duane Hookom, 2003
' this code may be included in any application/mdb providing
' this statement is left intact
' example
' tblFamily with FamID as numeric primary key
' tblFamMem with FamID, FirstName, DOB,...
' return a comma separated list of FirstNames for a FamID
' John, Mary, Susan
' in a Query
' SELECT FamID,
' ConcatenateFieldValues("SELECT FirstName
' FROM tblFamMem WHERE FamID =" & [FamID]) AS FirstNames
' FROM tblFamily;
'---------------------
' Modified by Ken Snell 29 October 2005
' *** THIS FUNCTION BUILDS A CONCATENATED STRING THAT CONTAINS
' *** THE VALUES OF ONE FIELD FOR EACH RECORD IN A TABLE OR
' *** QUERY, WITH EACH VALUE SEPARATED BY A SPECIFIED DELIMITER.
Dim strConcat As String
'======For ADO comment next 2 lines and =======
'====== uncomment out ADO lines below =======
Dim db As DAO.Database
Dim rs As DAO.Recordset
On Error Resume Next
strConcat = ""
'======For ADO comment out next 2 DAO lines and =======
'====== uncomment ADO lines below =======
Set db = CurrentDb
Set rs = db.OpenRecordset(pstrSQL)
'======For ADO uncomment next two lines and =====
'====== comment out DAO lines above and below ======
' Dim rs As New ADODB.Recordset
' rs.Open pstrSQL, CurrentProject.Connection, _
' adOpenKeyset, adLockOptimistic
With rs
If Not .EOF Then
.MoveFirst
Do While Not .EOF
strConcat = strConcat & .Fields(0) & pstrDelim
.MoveNext
Loop
End If
.Close
End With
Set rs = Nothing
'====== Comment next 2 lines for ADO ========
db.Close
Set db = Nothing
If Len(strConcat) > 0 Then strConcat = _
Left(strConcat, Len(strConcat) - Len(pstrDelim))
ConcatenateFieldValues = strConcat
Exit Function
End Function
