Duane Hookoms Concatenate Function 3

[SFATEK]

Hi I have been using Duanes code to concatenate names from at the same address e.g Jack,James, Jill

I would like to do Jack, James & Jill

Any Ideas on how to add the & before the last record?

Cheers


Ben


Function Concatenate(pstrSQL As String, _
Optional pstrDelim As String = ",") _
As String
'Created by Duane Hookom, 2003
Dim endstring As String
Dim rs As New ADODB.Recordset
rs.Open pstrSQL, CurrentProject.Connection, _
adOpenKeyset, adLockOptimistic
Dim strConcat As String 'build return string
Dim intCount As Integer
intCount = 0
With rs
If Not .EOF Then
.MoveFirst
Do While Not .EOF
' intCount = intCount + 1
strConcat = strConcat & _
"" & .Fields(0) & pstrDelim
.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))
End If
Concatenate = strConcat
End Function

 

[dhookom]

How about

Function Concatenate(pstrSQL As String, _
        Optional pstrDelim As String = ",", _
        Optional pstrLastDelim As String = ",") _
        As String
'Created by Duane Hookom, 2010
    Dim intLastDelimPosition As Integer
    Dim strLastField As String
    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
                strConcat = strConcat & _
                "" & .Fields(0) & pstrDelim
                strLastField = .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 pstrLastDelim <> pstrDelim Then
            intLastDelimPosition = InStrRev(strConcat, pstrDelim)
            
            strConcat = Left(strConcat, intLastDelimPosition) & _
                pstrLastDelim & strLastField
        End If
    
    End If
    Concatenate = strConcat
End Function

Duane
Hook'D on Access
MS Access MVP

 

[TonyJollans]

Hi Duane,

I was just looking at this as you posted and had a remarkably similar approach - except for two things ..

(1) I was keeping track of what you call intLastDelimPosition instead of determining it at the end ..

            Do While Not .EOF
                intLastDelimPosition = Len(strConcat)
                strConcat = strConcat & _
                "" & .Fields(0) & pstrDelim
                strLastField = .Fields(0)
                .MoveNext
            Loop

This way it didn't matter if the final element happened to contain pstrDelim

(2) I didn't bother to keep track of the elements, so at the end I just had ..

        strConcat = Left(strConcat, intLastDelimPosition - 1) & _
            pstrLastDelim & Mid(strConcat, intLastDelimPosition + 1)

This is neither better nor worse than yours - just different

Enjoy,
Tony

------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

I'm working (slowly) on my own website

 

[SkipVought]

How about a post process to the original process?

Function AddAmpersand(sList As String, Optional sDelim As String = ",")
    Dim a, i As Integer
    a = Split(sList, sDelim)
    For i = 0 To UBound(a)
        Select Case i
            Case UBound(a)
                AddAmpersand = Left(AddAmpersand, Len(AddAmpersand) - 1)
                AddAmpersand = AddAmpersand & "&" & a(i)
            Case Else
                AddAmpersand = AddAmpersand & a(i) & sDelim
        End Select
    Next
End Function

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[strongm]

or, taking a slightly different approach within the Concatenate function:

[blue]Function Concatenate(pstrSQL As String, _
        Optional pstrDelim As String = ",", _
        Optional pstrLastDelim As String = ",") _
        As String

    Dim intLastDelimPosition As Integer
    Dim strLastField As String
    Dim rs As New ADODB.Recordset
    rs.Open pstrSQL, mycon, _
        adOpenKeyset, adLockOptimistic
    Dim strConcat As String 'build return string
    Dim FirstNames As Variant
    Dim lp As Long
    
    If rs.RecordCount Then
        FirstNames = rs.GetRows(, , 0)
        strConcat = FirstNames(0, 0)
        For lp = 1 To UBound(FirstNames, 2)
            strConcat = strConcat & IIf(lp <> UBound(FirstNames, 2), pstrDelim, pstrLastDelim) & FirstNames(0, lp)
        Next
    End If
    
    Concatenate = strConcat
End Function[/blue]

 

[SFATEK]

Thanks for all the replies

I ended up using strongm's approach as it worked when there was only one record. Duanes process worked but if there was only one name it put the & in from of it e.g &Jill

Thanks again