Concatenate Function truncates memo field datas

[umutayberk]

I have set Allen Browne Concatenate function in my DB. The function combines muchtext multiple rows and yields truncated results.

Truncated field: tum_bulgu_durum_satir.[Tüm Bulgu Durumları]

How can i avoid truncation. My database can be downloaded from following link:

[Moderator edit{removed external link}]

Thank you in advance

Option Compare Database
 
Public Function ConcatRelated(strField As String, _
    strTable As String, _
    Optional strWhere As String, _
    Optional strOrderBy As String, _
    Optional strSeparator = ", ") As Variant
On Error GoTo Err_Handler
    'Purpose:   Generate a concatenated string of related records.
    'Return:    String variant, or Null if no matches.
    'Arguments: strField = name of field to get results from and concatenate.
    '           strTable = name of a table or query.
    '           strWhere = WHERE clause to choose the right values.
    '           strOrderBy = ORDER BY clause, for sorting the values.
    '           strSeparator = characters to use between the concatenated values.
    'Notes:     1. Use square brackets around field/table names with spaces or odd characters.
    '           2. strField can be a Multi-valued field (A2007 and later), but strOrderBy cannot.
    '           3. Nulls are omitted, zero-length strings (ZLSs) are returned as ZLSs.
    '           4. Returning more than 255 characters to a recordset triggers this Access bug:
    '               http://allenbrowne.com/bug-16.html
    Dim rs As DAO.Recordset         'Related records
    Dim rsMV As DAO.Recordset       'Multi-valued field recordset
    Dim strSql As String            'SQL statement
    Dim strOut As String            'Output string to concatenate to.
    Dim lngLen As Long              'Length of string.
    Dim bIsMultiValue As Boolean    'Flag if strField is a multi-valued field.
 
    'Initialize to Null
    ConcatRelated = Null
 
    'Build SQL string, and get the records.
    strSql = "SELECT " & strField & " FROM " & strTable
    If strWhere <> vbNullString Then
        strSql = strSql & " WHERE " & strWhere
    End If
    If strOrderBy <> vbNullString Then
        strSql = strSql & " ORDER BY " & strOrderBy
    End If
    Set rs = DBEngine(0)(0).OpenRecordset(strSql, dbOpenDynaset)
    'Determine if the requested field is multi-valued (Type is above 100.)
    bIsMultiValue = (rs(0).Type > 100)
 
    'Loop through the matching records
    Do While Not rs.EOF
        If bIsMultiValue Then
            'For multi-valued field, loop through the values
            Set rsMV = rs(0).Value
            Do While Not rsMV.EOF
                If Not IsNull(rsMV(0)) Then
                    strOut = strOut & rsMV(0) & strSeparator
                End If
                rsMV.MoveNext
            Loop
            Set rsMV = Nothing
        ElseIf Not IsNull(rs(0)) Then
            strOut = strOut & rs(0) & strSeparator
        End If
        rs.MoveNext
    Loop
    rs.Close
 
    'Return the string without the trailing separator.
    lngLen = Len(strOut) - Len(strSeparator)
    If lngLen > 0 Then
        ConcatRelated = Left(strOut, lngLen)
    End If
 
Exit_Handler:
    'Clean up
    Set rsMV = Nothing
    Set rs = Nothing
    Exit Function
 
Err_Handler:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "ConcatRelated()"
    Resume Exit_Handler
End Function

[nico5038]

For this you can create a workaround by using a function to build a result table like:

Function fncFillConcat()
 
Dim rsI As DAO.Recordset
Dim rsI2 As DAO.Recordset
Dim rsO As DAO.Recordset
Dim strTitle As String
Dim strTitleOld As String
 
' init table
CurrentDb.Execute ("Delete * from tblBulgu_Durumu_Result")
 
' Select the unique combinations of [Bulgu Kodu] and [Durum Tarihi]
Set rsI = CurrentDb.OpenRecordset("Select Distinct  [Bulgu Kodu], [Durum Yazan Denetçi] from [Bulgu_Durumu]")
Set rsO = CurrentDb.OpenRecordset("tblBulgu_Durumu_Result")
 
' Loop to add one row for each IDArtikkel
While Not rsI.EOF
    rsO.AddNew
    rsO![Bulgu Kodu] = rsI![Bulgu Kodu]
    'now concatenate all fields
    Set rsI2 = CurrentDb.OpenRecordset("Select Bulgu_Durumu.[Durum Tarihi] & '|' & Bulgu_Durumu.[Durum Yazan Denetçi] & ' :' as Title , Durum FROM Bulgu_Durumu where [Bulgu Kodu]='" & rsI![Bulgu Kodu] & "' and [Durum Yazan Denetçi]='" & rsI![Durum Yazan Denetçi] & "'")
    'first place title
    strTitle = rsI2![Title] & vbCrLf
    strTitleOld = rsI2![Title] & vbCrLf
    rsO![Durum] = strTitle
    While Not rsI2.EOF
       'Check for title change, when changed, add title
       strTitle = rsI2![Title] & vbCrLf
       If strTitle <> strTitleOld Then
          strTitleOld = strTitle
          rsO![Durum] = rsO![Durum] & vbCrLf & strTitle
       End If
       rsO![Durum] = rsO![Durum] & vbCrLf & rsI2![Durum]
       rsI2.MoveNext
    Wend
    rsO.Update
    rsI.MoveNext
Wend
 
 
End Function
 

Just define table "tblBulgu_Durumu_Result" with the fields:
Bulgu Kodu (Text)
Durum (Memo)

and run the function to fill this table.

Nic;o)

[umutayberk]

Hello Nico,

Thank you for your response.

The code works but it duplicates some [Bulgu Kodu] data.
[Bulgu Kodu] should be unique.

I believe it calculates unique combination as [Bulgu Kodu] & [Durum Yazan Denetçi]. I couldn't fix. Can you look line 13.

[nico5038]

Oops, try:

' Select the unique values of [Bulgu Kodu]
Set rsI = CurrentDb.OpenRecordset("Select Distinct  [Bulgu Kodu]  from [Bulgu_Durumu]")
 

Nic;o)

[umutayberk]

Thank you very much. Everything works perfect.