ACCESS FEED: Re: Re: [MS_AccessPros] New file uploaded to MS_Access

Minggu, 20 September 2015

Re: Re: [MS_AccessPros] New file uploaded to MS_Access_Professionals

John-

Can LoopAndCombine output like Paris-Tours-Dijon, use "-" instead of ","?

Kevin

Here's the code you gave me few years ago:

================Function Start (Create a 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 = "", Optional pOrderBy As String = "") As Variant
'PARAMETERS
'pTablename --> tablename or queryname to get list from (ie:"qExpenseItemsTotal)
'pIDFieldname --> fieldname to link on (ie: "ExpenseID")
'pTextFieldname --> fieldname to combine (ie: "ItemAndTotal")
'pValueID --> actual value of ID for this iteration ( ie: [ExpenseID])
'pWhere, Optional --> more criteria
'pDeli, Optional --> delimiter other than comma (ie: ";", Chr(13) & Chr(10))
'pNoValue, Optional --> value to use if no data (ie: "No Data")

'crystal 5-6-07, modified 090911, John corrected 14-09-09

'strive4peace2008 at yahoo dot com
On Error GoTo Proc_Err
LoopAndCombine = Null
Dim r As dao.Recordset, mAllValues As String, S As String
mAllValues = ""

S = "SELECT [" & pTextFieldname & "] " & " FROM [" & pTablename & "]" & " WHERE [" & pIDFieldname & "] = " & pValueID & IIf(Len(pWhere) > 0, "And " & pWhere, "") & IIf(Len(pOrderBy) > 0, " ORDER BY " & pOrderBy, "") & ";"

Set r = CurrentDb.OpenRecordset(S, dbOpenSnapshot)

Do While Not r.EOF
If Not IsNull(r(pTextFieldname)) Then
mAllValues = mAllValues & Trim(r(pTextFieldname)) & pDeli
End If
r.MoveNext
Loop

If Len(mAllValues) > 0 Then
mAllValues = Left(mAllValues, Len(mAllValues) - Len(pDeli))
LoopAndCombine = Trim(mAllValues)
ElseIf Len(pNoValue) > 0 Then
LoopAndCombine = pNoValue
End If
r.Close

Proc_Exit:
Set r = Nothing
Exit Function

Proc_Err:

MsgBox Err.Description, , "ERROR " & Err.Number & " LoopAndCombine"
Resume Proc_Exit
End Function
=================End====================

Regards,

Kevin Zhao

From: 'zhaoliqingoffice@163.com' zhaoliqingoffice@163.com [MS_Access_Professionals]
Date: 2015-09-20 16:31
To: MS_Access_Professionals
Subject: Re: [MS_AccessPros] New file uploaded to MS_Access_Professionals

John-
Sorry for my stupidity, I forgot to use an actual ID. Now the code works fine. Sorry for disturbing you.
Regards,
Kevin

Regards,
Kevin Zhao

From: MS_Access_Professionals
Date: 2015-09-20 16:06
To: MS_Access_Professionals
Subject: [MS_AccessPros] New file uploaded to MS_Access_Professionals

Hello,

This email message is a notification to let you know that
a file has been uploaded to the Files area of the MS_Access_Professionals
group.

File : /2_AssistanceNeeded/HorizontalDisplay.accdb
Uploaded by : qingqinga <zhaoliqingoffice@163.com>
Description : John-
I use the code you give me long time agao, It didn't work in access 2010, Please have look what wrong I did? I uploaded the file as "HorizontalDisplay" to group file. Please have a look. Thanks.
Kevin

================Function Start (Create a 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 = "", Optional pOrderBy As String = "") As Variant
'PARAMETERS
'pTablename --> tablename or queryname to get list from (ie:"qExpenseItemsTotal)
'pIDFieldname --> fieldname to link on (ie: "ExpenseID")
'pTextFieldname --> fieldname to combine (ie: "ItemAndTotal")
'pValueID --> actual value of ID for this iteration ( ie: [ExpenseID])
'pWhere, Optional --> more criteria
'pDeli, Optional --> delimiter other than comma (ie: ";", Chr(13) & Chr(10))
'pNoValue, Optional --> value to use if no data (ie: "No Data")

'crystal 5-6-07, modified 090911, John corrected 14-09-09

'strive4peace2008 at yahoo dot com
On Error GoTo Proc_Err
LoopAndCombine = Null
Dim r As dao.Recordset, mAllValues As String, S As String
mAllValues = ""

S = "SELECT [" & pTextFieldname & "] " & " FROM [" & pTablename & "]" & " WHERE [" & pIDFieldname & "] = " & pValueID & IIf(Len(pWhere) > 0, "And " & pWhere, "") & IIf(Len(pOrderBy) > 0, " ORDER BY " & pOrderBy, "") & ";"

Set r = CurrentDb.OpenRecordset(S, dbOpenSnapshot)

Do While Not r.EOF
If Not IsNull(r(pTextFieldname)) Then
mAllValues = mAllValues & Trim(r(pTextFieldname)) & pDeli
End If
r.MoveNext
Loop

If Len(mAllValues) > 0 Then
mAllValues = Left(mAllValues, Len(mAllValues) - Len(pDeli))
LoopAndCombine = Trim(mAllValues)
ElseIf Len(pNoValue) > 0 Then
LoopAndCombine = pNoValue
End If
r.Close

Proc_Exit:
Set r = Nothing
Exit Function

Proc_Err:

MsgBox Err.Description, , "ERROR " & Err.Number & " LoopAndCombine"
Resume Proc_Exit
End Function
=================End====================

You can access this file at the URL:
https://groups.yahoo.com/neo/groups/MS_Access_Professionals/files/2_AssistanceNeeded/HorizontalDisplay.accdb

To learn more about file sharing for your group, please visit:
https://help.yahoo.com/kb/index?page=content&y=PROD_GRPS&locale=en_US&id=SLN15398

Regards,

qingqinga <zhaoliqingoffice@163.com>