Solved

Loop to concatenate list

Posted on 2013-05-28
15
360 Views
Last Modified: 2013-05-29
I have a table that currently has 1 to many records in a single table.

Multiple reports where each report can have multiple email addresses (single record for each)  I need to take all the email address per each report name and display it in a single field per report name.

Reprt Name                   Email Dist List
ABC                                JoeSmith@abcCompany.com
ABC                                MikeJohnson@abcCompany.com
ABC                                FrankJames@abcCompany.com
DEF                                JoeSmith@DEFTrucking.com
DEF                                FrancisSmidtch@DEFTrucking.com
DEF                                JackieRobinson@DEFTrucking.com

Results should look like:

ABC                                JoeSmith@abcCompany.com;
                                     MikeJohnson@abcCompany.com;
                                      FrankJames@abcCompany.com;

DEF                                JoeSmith@DEFTrucking.com;
                                    FrancisSmidtch@DEFTrucking.com;
                                    JackieRobinson@DEFTrucking.com


Public Sub Concat() 
        Dim curDB As DAO.Database
        Dim rs As DAO.Recordset
        Dim strSQL As String
        Dim nCol As String
   On Error GoTo Concat_Error

        Set curDB = CurrentDb()
        
        strSQL = "SELECT RptName, DistList" & _
                " FROM tblReportDist" & _
                " ORDER BY RptName"

        Set rs = curDB.OpenRecordset(strSQL)
        rs.MoveFirst
        Do Until rs.EOF
            i = rs.Fields("DistList")
        
        With rs.Field("RptName")
        If rs.Count > 0 Then
        For Each i In rs.Field("RptName")
            MyString = Chr(34) & .ItemData(i) & Chr(34) & "," & MyString
        Next i
            MyString = Left(MyString, Len(MyString) - 1)
        End If
        rs.MoveNext
        Loop

Open in new window

0
Comment
Question by:Karen Schaefer
  • 9
  • 5
15 Comments
 
LVL 92

Expert Comment

by:Patrick Matthews
Comment Utility
You don't need VBA for that.  Standard report grouping will do that for you.

But if you insist on DPA...

1) Go to my article http://www.experts-exchange.com/Microsoft/Development/MS_Access/A_2380-Domain-Aggregate-for-Concatenating-Values-by-Group-in-Microsoft-Access.html

2) Add the DConcat function from that article to a regular VBA module:

Function DConcat(ConcatColumns As String, Tbl As String, Optional Criteria As String = "", _
    Optional Delimiter1 As String = ", ", Optional Delimiter2 As String = ", ", _
    Optional Distinct As Boolean = True, Optional Sort As String = "Asc", _
    Optional Limit As Long = 0)
    
    ' Function by Patrick G. Matthews, basically embellishing an approach seen in many
    ' incarnations over the years
    
    ' Requires reference to Microsoft DAO library
    
    ' This function is intended as a "domain aggregate" that concatenates (and delimits) the
    ' various values rather than the more usual Count, Sum, Min, Max, etc.  For example:
    '
    '    Select Field1, DConcat("Field2", "SomeTable", "[Field1] = '" & Field1 & "'") AS List
    '    FROM SomeTable
    '    GROUP BY Field1
    '
    ' will return the distinct values of Field1, along with a concatenated list of all the
    ' distinct Field2 values associated with each Field1 value.
    
    ' ConcatColumns is a comma-delimited list of columns to be concatenated (typically just
    '   one column, but the function accommodates multiple).  Place field names in square
    '   brackets if they do not meet the customary rules for naming DB objects
    ' Tbl is the table/query the data are pulled from.  Place table name in square brackets
    '   if they do not meet the customary rules for naming DB objects
    ' Criteria (optional) are the criteria to be applied in the grouping.  Be sure to use And
    '   or Or as needed to build the right logic, and to encase text values in single quotes
    '   and dates in #
    ' Delimiter1 (optional) is the delimiter used in the concatenation (default is ", ").
    '   Delimiter1 is applied to each row in the code query's result set
    ' Delimiter2 (optional) is the delimiter used in concatenating each column in the result
    '   set if ConcatColumns specifies more than one column (default is ", ")
    ' Distinct (optional) determines whether the distinct values are concatenated (True,
    '   default), or whether all values are concatenated (and thus may get repeated)
    ' Sort (optional) indicates whether the concatenated string is sorted, and if so, if it is
    '   Asc or Desc.  Note that if ConcatColumns has >1 column and you use Desc, only the last
    '   column gets sorted
    ' Limit (optional) places a limit on how many items are placed into the concatenated string.
    '   The Limit argument works as a TOP N qualifier in the SELECT clause
    
    Dim rs As DAO.Recordset
    Dim SQL As String
    Dim ThisItem As String
    Dim FieldCounter As Long
    
    On Error GoTo ErrHandler
    
    ' Initialize to Null
    
    DConcat = Null
    
    ' Build up a query to grab the information needed for the concatenation
    
    SQL = "SELECT " & IIf(Distinct, "DISTINCT ", "") & _
            IIf(Limit > 0, "TOP " & Limit & " ", "") & _
            ConcatColumns & " " & _
        "FROM " & Tbl & " " & _
        IIf(Criteria <> "", "WHERE " & Criteria & " ", "") & _
        Switch(Sort = "Asc", "ORDER BY " & ConcatColumns & " Asc", _
            Sort = "Desc", "ORDER BY " & ConcatColumns & " Desc", True, "")
        
    ' Open the recordset and loop through it:
    ' 1) Concatenate each column in each row of the recordset
    ' 2) Concatenate the resulting concatenated rows in the function's return value
    
    Set rs = CurrentDb.OpenRecordset(SQL)
    With rs
        Do Until .EOF
            
            ' Initialize variable for this row
            
            ThisItem = ""
            
            ' Concatenate columns on this row
            
            For FieldCounter = 0 To rs.Fields.Count - 1
                ThisItem = ThisItem & Delimiter2 & Nz(rs.Fields(FieldCounter).Value, "")
            Next
            
            ' Trim leading delimiter
            
            ThisItem = Mid(ThisItem, Len(Delimiter2) + 1)
            
            ' Concatenate row result to function return value
            
            DConcat = Nz(DConcat, "") & Delimiter1 & ThisItem
            .MoveNext
        Loop
        .Close
    End With
    
    ' Trim leading delimiter
    
    If Not IsNull(DConcat) Then DConcat = Mid(DConcat, Len(Delimiter1) + 1)
    
    GoTo Cleanup

ErrHandler:
    
    ' Error is most likely an invalid database object name, or bad syntax in the Criteria
    
    DConcat = CVErr(Err.Number)
    
Cleanup:
    Set rs = Nothing
    
End Function

Open in new window


3) Write a query like this:

SELECT [Reprt Name], 
    DConcat("[Email Dist List]", "[TblNameHere]", "[Reprt Name] = '" & [Reprt Name] & "'", Chr(13) & Chr(10)) AS Concatenated
FROM [TblNameHere]
GROUP BY [Reprt Name]

Open in new window


4) Base your report on that query
0
 

Author Comment

by:Karen Schaefer
Comment Utility
Thank you I tried that ran into an truncation issue - Unable to use query to create when data is greater than 255 chars.  Hence the need to create a loop in VBA, that will update a memo field in a table.

K
0
 

Author Comment

by:Karen Schaefer
Comment Utility
Here is what I have so far:

Currently having issues with comparing the recordset from the 2 sqlstrings:

If rs.Fields("RptName") = rs1.Fields("RptName") Then


Public Function fConcatEMailAddr()
Dim curDB As DAO.Database
'Dim rstEAddr As DAO.Recordset
Dim strBuild As String
Dim rs As DAO.Recordset, rs1 As DAO.Recordset
Dim strSQL As String, strSQL1 As String

Set curDB = CurrentDb()

'Set rstEAddr = curDB.OpenRecordset("Select RptName, DistList From tblReportDist")

strSQL = "SELECT tblDailyLog.Name, tblReportDist.DistList" & _
            " FROM tblDailyLog INNER JOIN tblReportDist ON tblDailyLog.Name = tblReportDist.RptName"
Set rs = curDB.OpenRecordset(strSQL)

strSQL1 = "Select RptName, DistList from tblReportDist"
Set rs1 = curDB.OpenRecordset(strSQL1)

If rs.Fields("RptName") = rs1.Fields("RptName") Then
   Debug.Print rs!RptName
   rs.MoveFirst
   With rs1!DistList
      
      Do While Not rs.EOF
        If rs1![DistList] <> "" Then
          strBuild = strBuild & rs1![DistList] & ";"
        End If
          rs.MoveNext
      Loop
    End With
 End If
rs.Close
rs1.Close
Set rs = Nothing
Set rs1 = Nothing

Debug.Print
fConcatEMailAddr = Left$(strBuild, Len(strBuild) - 1)
Debug.Print fConcatEMailAddr
End Function

Open in new window

0
 
LVL 92

Expert Comment

by:Patrick Matthews
Comment Utility
The attached database has 10 groups of 50 email addresses each, with the concatenation exceeding 1000 characters.  As you can see if you run the report, it works just fine.

I suspect there is something you are not telling us about your true requirements.
Q-28141088.mdb
0
 
LVL 92

Expert Comment

by:Patrick Matthews
Comment Utility
Also, based on your original statement of the problem, I am still not understanding why you need the concatenation at all, because the result you laid out in your question can be accomplished with nothing more exotic than standard report grouping levels.
0
 

Author Comment

by:Karen Schaefer
Comment Utility
I want a list of all Report names and those emails assigned to a particular Report.

Note:  I am not using aAccess Report to display the data - My user would like to see it in either a query or table.  When I try to use the Dconcat function in a query it only displays the 255 chars.

I am also using an old Access 2000 mdb in Access 2003.
0
 
LVL 92

Expert Comment

by:Patrick Matthews
Comment Utility
Trying to handle this in a table or query instead of a report is very suboptimal.  Is there some reason why it cannot be a report?

By resizing the column widths and row heights in the query data sheets I can see all the data, even though my samples run to about 1,100 characters for each concatenated block.

Q-28141088.mdb

Do note that while the file format is Access 2000, I am doing my work in Access 2010.  I do not have ready access to an Access 2003 environment right now.
0
Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

 

Author Comment

by:Karen Schaefer
Comment Utility
I am unable to reconcile your code - running into reference differences - I am using Acccess 2003, with Object library 11..

My user wants a query, definitely not a Access report, he would prefer an export to Excel except, you run into the Truncation issue.

I had it working briefly, however, now I am running into a type mismatch issue on my query for the Dconcat field.

K
0
 

Author Comment

by:Karen Schaefer
Comment Utility
I can't get it to close, trapped in reference issues. with your version.
0
 

Author Comment

by:Karen Schaefer
Comment Utility
Ok Lets try this.

I am writing VBA to execute and append a table that will display the Report name, list of Email addresses, pertinent to that report list.


I am having problems with type mismatch on the Distribution list function.  The Original field from the 2 tables are text,  The table I am writing to is a Memo.

Sql String:

SELECT tblDailyLog.Name, DConcat('DistList','TblReportDist.DistList') AS DistbList FROM tblDailyLog INNER JOIN tblReportDist ON tblDailyLog.Name = tblReportDist.RptName WHERE (((tblDailyLog.Period) <> 'Discontinued')) ORDER BY tblDailyLog.Name


Also having issues with the query.
Public Function ConcatDistList()
Dim curDB As DAO.Database
Dim strSQL As String, strSQL1 As String
Dim rs As DAO.Recordset, rs1 As DAO.Recordset
Dim MyString As String
   On Error GoTo ConcatDistList_Error

Set curDB = CurrentDb()

curDB.Execute ("Delete * from tblReportLIst_DistLst")
'strSQL = "INSERT INTO tblReportList_DistLst ( Name, Type, Period, DistributionList, Special," & _
        " RunDate, [Day], JobName, [Number], [Order], UpdateDate, RunTime, Priority, SaveToHistory," & _
        " Owner, ManualTask )" & _

'strSQL = "INSERT INTO tblReportList_DistLst ( Name, DistributionList)" & _

strSQL = " SELECT tblDailyLog.Name, DConcat('DistList','TblReportDist.DistList') AS DistbList," & _
        " FROM tblDailyLog INNER JOIN tblReportDist ON tblDailyLog.Name = tblReportDist.RptName" & _
        " WHERE (((tblDailyLog.Period) <> 'Discontinued'))" & _
        " ORDER BY tblDailyLog.Name"

'        " SELECT tblDailyLog.Name, tblDailyLog.Type, tblDailyLog.Period, DConcat('DistList','TblReportDist') AS DistbList," & _
        " tblDailyLog.Special, tblDailyLog.RunDate, tblDailyLog.Day, tblDailyLog.JobName, tblDailyLog.Number," & _
        " tblDailyLog.Order, tblDailyLog.UpdateDate, tblDailyLog.RunTime, tblDailyLog.Priority," & _
        " tblDailyLog.SaveToHistory, tblDailyLog.Owner, tblDailyLog.ManualTask" & _
        " FROM tblDailyLog INNER JOIN tblReportDist ON tblDailyLog.Name = tblReportDist.RptName" & _
        " GROUP BY tblDailyLog.Name, tblDailyLog.Type, tblDailyLog.Period, DConcat('DistList','TblReportDist.DistList')," & _
        " tblDailyLog.Special, tblDailyLog.RunDate, tblDailyLog.Day, tblDailyLog.JobName, tblDailyLog.Number," & _
        " tblDailyLog.Order, tblDailyLog.UpdateDate, tblDailyLog.RunTime, tblDailyLog.Priority," & _
        " tblDailyLog.SaveToHistory, tblDailyLog.Owner, tblDailyLog.ManualTask" & _
        " HAVING (((tblDailyLog.Period) <> 'Discontinued'))" & _
        " ORDER BY tblDailyLog.Name, tblDailyLog.Period;"


Debug.Print strSQL
curDB.Execute (strSQL)
DoCmd.OpenTable "_tblReportLIst_DistLst", acViewNormal, acReadOnly
   On Error GoTo 0
   Exit Function

ConcatDistList_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure ConcatDistList of Module _modDConcat"

End Function

Open in new window


I want to include all the fields above in the query to update an existing table or atleast display the query results.  Keep getting "TYPE MISMATCH"
0
 

Author Comment

by:Karen Schaefer
Comment Utility
here is my latest - still truncating the distribution list to 255 chars.What am I doing wrong?

Here is my current code, it is still truncating the Distrbution list to 255 chars.

[code]
Public Function ConcatDistList()
Dim curDB As DAO.Database
Dim strSQL As String, strSQL1 As String
Dim rs As DAO.Recordset, rs1 As DAO.Recordset
Dim MyString As String
   On Error GoTo ConcatDistList_Error

Set curDB = CurrentDb()

curDB.Execute ("Delete * from tblReportLIst_DistLst")

strSQL = "INSERT INTO tblReportLIst_DistLst ( Name, Period, DistributionList )" & _
        " SELECT tblDailyLog.Name, tblDailyLog.Period, DConcat('DistList','tblReportDist') AS DistbList" & _
        " FROM tblDailyLog INNER JOIN tblReportDist ON tblDailyLog.Name = tblReportDist.RptName" & _
        " GROUP BY tblDailyLog.Name, tblDailyLog.Period, DConcat('DistList','tblReportDist')" & _
        " HAVING (((tblDailyLog.Period)<>'Discontinued'))" & _
        " ORDER BY tblDailyLog.Name"

'strSQL = "INSERT INTO tblReportList_DistLst ( Name, Type, Period, DistributionList, Special," & _
        " RunDate, [Day], JobName, [Number], [Order], UpdateDate, RunTime, Priority, SaveToHistory," & _
        " Owner, ManualTask )" & _

'strSQL = " SELECT tblDailyLog.Name, tblDailyLog.Type, tblDailyLog.Period, DConcat('DistList','TblReportDist') AS DistbList," & _
        " tblDailyLog.Special, tblDailyLog.RunDate, tblDailyLog.Day, tblDailyLog.JobName, tblDailyLog.Number," & _
        " tblDailyLog.Order, tblDailyLog.UpdateDate, tblDailyLog.RunTime, tblDailyLog.Priority," & _
        " tblDailyLog.SaveToHistory, tblDailyLog.Owner, tblDailyLog.ManualTask" & _
        " FROM tblDailyLog INNER JOIN tblReportDist ON tblDailyLog.Name = tblReportDist.RptName" & _
        " GROUP BY tblDailyLog.Name, tblDailyLog.Type, tblDailyLog.Period, DConcat('DistList','TblReportDist.DistList')," & _
        " tblDailyLog.Special, tblDailyLog.RunDate, tblDailyLog.Day, tblDailyLog.JobName, tblDailyLog.Number," & _
        " tblDailyLog.Order, tblDailyLog.UpdateDate, tblDailyLog.RunTime, tblDailyLog.Priority," & _
        " tblDailyLog.SaveToHistory, tblDailyLog.Owner, tblDailyLog.ManualTask" & _
        " HAVING (((tblDailyLog.Period) <> 'Discontinued'))" & _
        " ORDER BY tblDailyLog.Name, tblDailyLog.Period;"


Debug.Print strSQL
curDB.Execute (strSQL)
DoCmd.OpenTable "tblReportLIst_DistLst", acViewNormal, acReadOnly
   On Error GoTo 0
   Exit Function

ConcatDistList_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure ConcatDistList of Module _modDConcat"

End Function

Open in new window

0
 
LVL 92

Accepted Solution

by:
Patrick Matthews earned 500 total points
Comment Utility
I asked some additional Experts to look at this, and the feedback I am getting is that my sample file is working just fine in Access 2003.

Now...

1) You did not state in your original question that you were exporting to Excel.  I wish you had mentioned that before, because that imposes limits of its own.  If you use TransferSpreadsheet to export by code, then yes, the data will truncate at 255 characters

2) Your original question said that you had a simple table with two columns.  The code you posted in your last two comments paints a very different picture.
0
 

Author Comment

by:Karen Schaefer
Comment Utility
Yes I am asking only my original question, I stated that the user wish we could export to excel, and I explained the issue with truncated data will prevent this..

I know have the code as follows - still having an issue with the Dconcat function and the proper syntax - quotes and all.

Public Function ConcatDistList()
Dim curDB As DAO.Database
Dim strSQL As String, strSQL1 As String
Dim rs As DAO.Recordset, rs1 As DAO.Recordset
Dim MyString As String
   On Error GoTo ConcatDistList_Error

Set curDB = CurrentDb()

curDB.Execute ("Delete * from tblReportLIst_DistLst")

'strSQL = "INSERT INTO tblReportLIst_DistLst ( Name, Period, DistributionList )" & _
        " SELECT tblDailyLog.Name, tblDailyLog.Period, DConcat('DistList','tblReportDist') AS DistbList" & _
        " FROM tblDailyLog INNER JOIN tblReportDist ON tblDailyLog.Name = tblReportDist.RptName" & _
        " GROUP BY tblDailyLog.Name, tblDailyLog.Period" & _
        " HAVING (((tblDailyLog.Period)<>'Discontinued'))" & _
        " ORDER BY tblDailyLog.Name"

strSQL = "INSERT INTO tblReportList_DistLst ( Name, Type, Period, Special," & _
        " RunDate, [Day], JobName, [Number], [Order], UpdateDate, RunTime, Priority, SaveToHistory," & _
        " Owner, ManualTask )" & _
        " SELECT tblDailyLog.Name, tblDailyLog.Type, tblDailyLog.Period," & _
        " tblDailyLog.Special, tblDailyLog.RunDate, tblDailyLog.Day, tblDailyLog.JobName, tblDailyLog.Number," & _
        " tblDailyLog.Order, tblDailyLog.UpdateDate, tblDailyLog.RunTime, tblDailyLog.Priority," & _
        " tblDailyLog.SaveToHistory, tblDailyLog.Owner, tblDailyLog.ManualTask" & _
        " FROM tblDailyLog INNER JOIN tblReportDist ON tblDailyLog.Name = tblReportDist.RptName" & _
        " GROUP BY tblDailyLog.Name, tblDailyLog.Type, tblDailyLog.Period," & _
        " tblDailyLog.Special, tblDailyLog.RunDate, tblDailyLog.Day, tblDailyLog.JobName, tblDailyLog.Number," & _
        " tblDailyLog.Order, tblDailyLog.UpdateDate, tblDailyLog.RunTime, tblDailyLog.Priority," & _
        " tblDailyLog.SaveToHistory, tblDailyLog.Owner, tblDailyLog.ManualTask" & _
        " HAVING (((tblDailyLog.Period) <> 'Discontinued'))" & _
        " ORDER BY tblDailyLog.Name, tblDailyLog.Period"
curDB.Execute (strSQL)
 
strSQL = "Update tblReportList_DistLst" & _
                " SET DistributionList = DConcat('DistList', 'TblReportDist', '[RptName] =  '''" & [tblDailyLog].[Name] & "''')" & _
                " WHERE tblReportList_DistLst.DistributionList Is Null"
Debug.Print strSQL
curDB.Execute (strSQL)
DoCmd.OpenTable "tblReportLIst_DistLst", acViewNormal, acReadOnly
   On Error GoTo 0
   Exit Function

ConcatDistList_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure ConcatDistList of Module _modDConcat"

End Function

Open in new window


Having an issue with the Update statement and using the DConcat function:

strSQL = "Update tblReportList_DistLst" & _
                " SET DistributionList = DConcat('DistList', 'TblReportDist', '[RptName] =  '''" & [tblDailyLog].[Name] & "''')" & _
                " WHERE tblReportList_DistLst.DistributionList Is Null"
0
 
LVL 26

Expert Comment

by:Nick67
Comment Utility
Hey,

What back-end are you using?  Are these tables all local, all Access front end / Access backend, or are you using and ODBC (SQL Server etc) backend?

That can be one source of pain

Another source of pain can be joins on various kinds of text fields.  No joy results from a JOIN on two memo fields, as Access doesn't like the idea of comparing unlimited amounts of text on both sides of a JOIN, and it truncates to 255.

But it strikes me that you don't really want a big long delimited string
Somebody wants to copy-and-paste into the To: line of an email, right?
0
 

Author Closing Comment

by:Karen Schaefer
Comment Utility
Partial Solution - Thanks Patrick for the great code for DConcat - Always appreciated when you come to my rescue.

Final solution can be found at :  http://www.experts-exchange.com/Microsoft/Development/MS_Access/Q_28138761.html
0

Featured Post

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

In a multiple monitor setup, if you don't want to use AutoCenter to position your popup forms, you have a problem: where will they appear?  Sometimes you may have an additional problem: where the devil did they go?  If you last had a popup form open…
Whether you've completed a degree in computer sciences or you're a self-taught programmer, writing your first lines of code in the real world is always a challenge. Here are some of the most common pitfalls for new programmers.
Familiarize people with the process of retrieving data from SQL Server using an Access pass-thru query. Microsoft Access is a very powerful client/server development tool. One of the ways that you can retrieve data from a SQL Server is by using a pa…
In Microsoft Access, learn how to “cascade” or have the displayed data of one combo control depend upon what’s entered in another. Base the dependent combo on a query for its row source: Add a reference to the first combo on the form as criteria i…

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now