I've inherited a database that uses string comparison to combine
multiple first names in a family with a single family last name in a
membership database. The code works, but it's not documented and
I'd like to get a full understanding of what it's doing. And I was
wondering if I could get a pointer to some reading.
Here's the full module:
Public Sub CombinePersons()
On Error GoTo CombinePersonsError
Dim db As DAO.Database
Dim dsPrimeRec As DAO.Recordset, Inconsistent
Dim dsSecondRec As DAO.Recordset
Static LastNames(1 To 5) As String, FirstNames(1 To 5, 1 To 7) As
String
Static NumOfFirsts(1 To 5) As Integer
Set db = CurrentDb()
Inconsistent = True
Set dsPrimeRec = db.OpenRecordset("tblTempMailList")
Set dsSecondRec = dsPrimeRec.Clone()
dsSecondRec.MoveNext
'Open "lpt1" For Output As #1
Do Until dsPrimeRec.EOF Or dsSecondRec.EOF ' for each primary
record
NumDeletes = 0
NumOfLasts = 1
LastNames(1) = dsPrimeRec![Last Name]
NumOfFirsts(1) = 1
FirstNames(1, 1) = dsPrimeRec![First Name]
' for each secondary record, i.e. each following record with
same address key
Do Until dsSecondRec.EOF
If dsPrimeRec![membershipID] <> dsSecondRec![membershipID] Then
Exit Do
End If
' find matching lasts if any
If LastNames(NumOfLasts) = dsSecondRec![Last Name] Then
' add to firsts
NumOfFirsts(NumOfLasts) = NumOfFirsts(NumOfLasts) + 1
FirstNames(NumOfLasts, NumOfFirsts(NumOfLasts)) =
dsSecondRec![First Name]
Else
' New Last
NumOfLasts = NumOfLasts + 1
LastNames(NumOfLasts) = dsSecondRec![Last Name]
NumOfFirsts(NumOfLasts) = 1
FirstNames(NumOfLasts, 1) = dsSecondRec![First Name]
End If
' delete absorbed record
dsSecondRec.Delete
dsSecondRec.MoveNext
NumDeletes = NumDeletes + 1
Loop
dsPrimeRec.Edit
dsPrimeRec![Name] = ""
For i = 1 To NumOfLasts
If i <> 1 Then
dsPrimeRec![Name] = dsPrimeRec![Name] & ", "
End If
For j = 1 To NumOfFirsts(i)
If j <> 1 Then
dsPrimeRec![Name] = dsPrimeRec![Name] & " & "
End If
dsPrimeRec![Name] = dsPrimeRec![Name] & FirstNames(i, j)
Next
dsPrimeRec![Name] = dsPrimeRec![Name] & " " & LastNames(i)
Next
dsPrimeRec.Update
' print combined record
Debug.Print dsPrimeRec![Name]
' Print #1, dsPrimeRec![Name]
' For i = 0 To NumDeletes
dsPrimeRec.MoveNext
' Next
If Not dsSecondRec.EOF Then
dsSecondRec.MoveNext
End If
Loop
Close #1
MsgBox "New member mail list is ready.", vbOKOnly
CombinePersonsError:
If Err.Number = 3021 Then
MsgBox "There are no memberships with unsent cards and keys."
Exit Sub
End If
'this code was added by ian
NumOfDeletes = 0
NumOfLasts = 1
End Sub
Yahoo! Groups Links
<*> To visit your group on the web, go to:
http://groups.yahoo.com/group/AccessVBACentral/
<*> To unsubscribe from this group, send an email to:
[EMAIL PROTECTED]
<*> Your use of Yahoo! Groups is subject to:
http://docs.yahoo.com/info/terms/
