code: LoopAndCombine
---
~~~
How to Create a General Module
1. from the database window, click on the Module tab
2. click on the NEW command button
3. type (or paste) the code in
once the code is in the module sheet, do
Debug,Compile from the menu
if there are no syntax/reference errors, nothing will appear to happen
-- this is good
Make sure to give the module a good name when you save it. You can have
several procedures in a module, so I like to group them.
this function goes into a general module
'~~~~~~~~~~~~~~~~
Function LoopAndCombine( _
pTablename As String, _
pIDFieldname As String, _
pTextFieldname As String, _
pValueID As Long, _
Optional pWhere As String, _
Optional pDeli As String, _
Optional pNoValue as string) As String
'crystal 8-3-06
'strive4peace2006 at yahoo dot com
'NEEDS REFERENCE
'Microsoft DAO Library
'PARAMETERS
'pTablename --> tablename to get list from
'pIDFieldname --> fieldname to link on (ie: "BookID")
'pTextFieldname --> fieldname to combine (ie: "PageNumber")
'pValueID --> actual value of ID for this iteration ( ie: [BookID])
'pWhere, Optional --> more criteria (ie: "Year(PubDate) = 2006")
'pDeli, Optional --> delimiter other than comma (ie: ";")
'pNoValue, Optional --> value to use if no data (ie: "No Pages")
'Set up error handler
On Error GoTo Proc_Err
'dimension variables
Dim r As dao.Recordset, mAllValues As String, S As String
Dim mValueDeli As String
If Len(nz(pDeli,"")) > 0 Then _
mValueDeli = pDeli Else mValueDeli = ","
mAllValues = ""
S = "SELECT [" & pTextFieldname & "] " _
& " FROM [" & pTablename & "]" _
& " WHERE [" & pIDFieldname _
& "] = " & pValueID _
& IIf(Len(pWhere) > 0, " AND " & pWhere, "") _
& ";"
'open the recordset
Set r = CurrentDb.OpenRecordset(S, dbOpenSnapshot)
'loop through the recordset until the end
Do While Not r.EOF
If Not IsNull(r(pTextFieldname)) Then
'~~~~~~~~~~~~~~~~~~~~~~~~~ CHOOSE ONE
'---- if fieldname is numeric
'mAllValues = mAllValues _
& " " & r(pTextFieldname) & mValueDeli
'---- if fieldname is text
mAllValues = mAllValues _
& " '" & r(pTextFieldname) & "'" & mValueDeli
'~~~~~~~~~~~~~~~~~~~~~~~~~
End If
r.MoveNext
Loop
If len(mAllValues) = 0 then
mAllValues = nz(pNoValue,"")
end if
Proc_Exit:
'close the recordset
r.Close
'release the recordset variable
Set r = Nothing
LoopAndCombine = Trim(mAllValues)
Exit Function
'if there is an error, the following code will execute
Proc_Err:
MsgBox Err.Description, , _
"ERROR " & Err.Number _
& " LoopAndCombine"
'press F8 to step through code and debug
'remove next line after debugged
Stop: Resume
Resume Proc_Exit
End Function
'~~~~~~~~~~~~~~~~
pTablename As String --> "[tblEmail]"
(name of the table containing this information)
pIDFieldname As String --> "[PeopleID]"
(name of Primary Key field, assumed to be long integer)
pTextFieldname As String --> "[primaryEmail]"
(the name of the filed with the email address (assumed to be text)
pValueID As Long --> [PeopleID]
(value of Primary Key field you want to combine)
Optional pWhere As String --> if you want to further specify records
within a matching Supplier Code, if not --> just put comma to skip
argument if you are specifying optional arguments after this
Optional pDeli As String -- optional if you want something in
addition to space around each value -- a comma is used is nothing is
specified
Optional pNoValue as string --> what to return if there are no records
'~~~~~~~~~~~~~~~~
so, in a query, here is what you would do (we will skip the optional
arguments:
AllEmail: LoopAndCombine(
"[tblEmail]",
"[PeopleID]",
"[primaryEmail]",
[PeopleID])
~~~~~~~~~~~~~~~~~~~~`
in a report or on a form:
ControlSource -->
=LoopAndCombine("[tblEmail]","[PeopleID]","[primaryEmail]",[PeopleID])
Warm Regards,
Crystal
*
have an awesome day
*
MVP Access
Remote Programming and Training
strive4peace2006 at yahoo.com
*
