Function Concatenate(pstrSQL As String, _
Optional pstrDelim As String = ", ", _
Optional pstrLastDelim As String = "") _
As Variant
' Created by Duane Hookom, 2003
' Modified 6/30/2014 to correct some issues
' 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,
' Concatenate("SELECT FirstName FROM tblFamMem
' WHERE FamID =" & [FamID]) as FirstNames
' FROM tblFamily
' ============================================
' to get a return like Duane, Laura, Jake, and Chelsey
' ======= in a Query =========================
' SELECT FamID,
' Concatenate("SELECT FirstName FROM tblFamMem
' WHERE FamID =" & [FamID], ",",", and ") as FirstNames
' FROM tblFamily
' ============================================
' If FamID is a string rather than numeric,
' it will need to be delimited with quotes
' ======= in a Query =========================
' SELECT FamID,
' Concatenate("SELECT FirstName FROM tblFamMem
' WHERE FamID =""" & [FamID] & """", ",",", and ") as FirstNames
' FROM tblFamily
' ============================================
'======For DAO uncomment next 4 lines=======
'====== comment out ADO below =======
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim intCount As Integer
Dim strLastValue As String
Dim intLenB4Last As Integer 'length before last concatenation
Set db = CurrentDb
Set rs = db.OpenRecordset(pstrSQL)
'======For ADO uncomment next two lines=====
'====== comment out DAO above ======
'Dim rs As New ADODB.Recordset
'rs.Open pstrSQL, CurrentProject.Connection, _
adOpenKeyset, adLockOptimistic
Dim strConcat As String 'build return string
With rs
If Not .EOF Then
.MoveFirst
Do While Not .EOF
intCount = intCount + 1
intLenB4Last = Len(strConcat)
strConcat = strConcat & _
.Fields(0) & pstrDelim
strLastValue = .Fields(0)
.MoveNext
Loop
End If
.Close
End With
Set rs = Nothing
'====== uncomment next line for DAO ========
Set db = Nothing
If Len(strConcat) > 0 Then
strConcat = Left(strConcat, _
Len(strConcat) - Len(pstrDelim))
If Len(pstrLastDelim) > 0 And intCount > 1 Then
strConcat = Left(strConcat, intLenB4Last - Len(pstrDelim)) & pstrLastDelim & strLastValue
End If
End If
If Len(strConcat) > 0 Then
Concatenate = strConcat
Else
Concatenate = Null
End If
End Function
