Concatenating Phone Numbers for Report

[JohnHarkins]

This ought to be simple.

I have:

tblMembers (main database)
tblPhones (zero, one or more records per member)

The result should look something like this for home, business, fax phones, etc. NB: where phone is in "our" area code (e.g., 203), no area code is listed. H=home, O=office, F=fax, M=mobile. text line box allows two "local" numbers, but only one non-local.

Member A  555-1212 (H), 555-1213 (O),
          (914) 555-1214 (OF),
          (212) 555-1215 (M)

I want to create a single field (with some appropriate vbCRLF characters) to show the phone numbers for a given member. Of course, the phone numbers are separate records in the database and they include an area code in all cases.

I think that I need:
1. a query to pull all the phone numbers and sort them for a given member
2. a subreeport to handle the display
3. a piece of VBA code to examine the data and string together successive row/records for the phone numbers for the given member, put commas in, decide on where to break the line, etc.

Ideally, I'd like the solution to show the string with non-breaking spaces and non-breaking hyphens to assist in formatting the result. That may have to be jerry-rigged in order to get around the limitations of strings in a text box.

Am I on the right track? Is there a simpler way to handle this?

Thanks John Harkins

 

[Dustman]

Hey, here's some code that might help you out. I've used this before to get a list kind of like that. This one will just grab the phone numbers and put them all in a string with a , in between them. Put this code in a public module and then you can call it from anywhere (queries, text boxes, whatever.. just use GetPhones(int) and it will show up)
[tt]
Function GetPhones(primaryID As Integer) As String
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set dbs = CurrentDb

Dim PhoneNums As String
Set rst = dbs.OpenRecordset("SELECT phonenumber FROM tblPhone WHERE primaryID = " & primaryID & ";&quot
Do While Not rst.EOF
PhoneNums = PhoneNums & "," & rst!phonenumber
rst.MoveNext
Loop
'Trim the leading comma off
PhoneNums = Mid(PhoneNums, 2)
GetPhones = PhoneNums
End Function
[/tt]

Just edit the red part to format it however you need. -Dustin
Rom 8:28

 

[JohnHarkins]

Thanks, Dustin. I'll try it right away. John Harkins

 

[JohnHarkins]

Hi, Dustin!

The only glitch when testing the code using a query was that if I wanted a specific numeric value for the MemberID (e.g., the number "3&quot I had to put the value within single quotation marks; i.e., getphones('3'). Is this correct? I thought I could just use getphones(3). Oh, well.

Thanks to you, here's the final, working SQL statement. It's great.

      "SELECT " & _
          "tblCommPhones.ID, " & _
          "tblCommPhones.MemberID, " & _
          "tblCommPhones.[Last Name], " & _
          "tblCommPhones.UseAt, " & _
          "tblCommPhones.UseFor, " & _
          "tblCommPhones.Phone, " & _
          "tblCommPhones.Ext " & _
        "FROM tblCommPhones " & _
        "WHERE (((tblCommPhones.MemberID)=" & MemberID & ")) " & _
        "ORDER BY " & _
          "tblCommPhones.UseAt, " & _
          "tblCommPhones.UseFor DESC" & _
          ";" _
        )

John Harkins

 

[Dustman]

Hmm.. I thought you should be able to use it without the single quotes. Is your MemberID a regular number field? If not, that could be the reason. Doesn't matter too much though, if it works like it is, leave it be . -Dustin
Rom 8:28

 

[JohnHarkins]

Thought you might like to see what the code that does the job for me looks like.

BTW, if there are any inveterate code-readers out here in cyberspace who'd like to comment on elegant changes they'd recommend to the code, I sure would appreciate the comments.

' function from Dustin on Tek-Tips, 1/10/03
Public Function GetPhones(MemberID As Integer) As String
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set dbs = CurrentDb

Dim lenPhoneLine As Integer

' length of current PhoneNums line
Dim maxlenPhoneLine As Integer

' maximum line length for a line of PhoneNums before CRLF
Dim rawPhoneNum As String

' 10-digit phone number, unformatted
Dim fmtdPhoneNum As String

' work area for phone number from recordset
Dim PhoneNums As String

' work area for string that is returned to function's caller
lenPhoneLine = 0
maxlenPhoneLine = 38

' get phone numbers for MemberID;
' sort by UseAt and UseFor
Set rst = dbs.OpenRecordset( _
  "SELECT " & _          "tblCommPhones.ID, " & _
      "tblCommPhones.MemberID, " & _
      "tblCommPhones.[Last Name], " & _
      "tblCommPhones.UseAt, " & _
      "tblCommPhones.UseFor, " & _
      "tblCommPhones.Phone, " & _
      "tblCommPhones.Ext, " & _
      "tblCommPhones.Notes " & _
    "FROM tblCommPhones " & _
    "WHERE (((tblCommPhones.MemberID)=" & MemberID & ")) " & _
    "ORDER BY " & _
      "tblCommPhones.UseAt, " & _
      "tblCommPhones.UseFor DESC" & _
  ";" _
  )

Do While Not rst.EOF
' perform any special processing of phone numbers here

' assign phone number from recordset
rawPhoneNum = rst!Phone
fmtdPhoneNum = ""

' initialize fmtdPhoneNum string
PhoneNums = PhoneNums & ", "
' keep track of length of PhoneNums string
' prefix descriptor (e.g., "(H)", "(HF)"
fmtdPhoneNum = fmtdPhone & "(" & Left(StrConv(rst!UseAt, vbUpperCase), 1)
If StrConv(rst!UseFor, vbUpperCase) = "FAX" Then
  fmtdPhoneNum = fmtdPhoneNum & "F"
Else
  fmtdPhoneNum = fmtdPhoneNum & ""
End If

fmtdPhoneNum = fmtdPhoneNum & ") "

' build local/long-distance, formatted phone number
If Left(rawPhoneNum, 3) <> &quot;203&quot; Then
  fmtdPhoneNum = fmtdPhoneNum & &quot;(&quot; & Left(rawPhoneNum, 3) & &quot;) &quot;
Else
End If

' format remainder of phone number
fmtdPhoneNum = fmtdPhoneNum & _
  Mid(rawPhoneNum, 4, 3) & &quot;-&quot; & _
  Mid(rawPhoneNum, 7, 4)

' add extension, if present
If IsNull(rst!Ext) Then
Else
  fmtdPhoneNum = fmtdPhoneNum & &quot; x &quot; & rst!Ext
End If

' add special notes, if present
If IsNull(rst!Notes) Then
Else
  fmtdPhoneNum = fmtdPhoneNum & Chr(151) & rst!Notes
End If

' make sure current phone with prefix, comma, and notes will fit on a line
If (lenPhoneLine + Len(fmtdPhoneNum)) > maxlenPhoneLine Then
  If (lenPhoneLine > 0) Then
    PhoneNums = PhoneNums & vbCrLf
    lenPhoneLine = 0
  End If
Else
End If

lenPhoneLine = lenPhoneLine + Len(fmtdPhoneNum)
PhoneNums = PhoneNums & fmtdPhoneNum

rst.MoveNext

Loop

'Trim the leading comma and space
PhoneNums = Mid(PhoneNums, 3)

' return function's value
GetPhones = PhoneNums
End Function

Regards,
John Harkins