N
Niklas Östergren
Hi!
I´m trying to loop throug a recordset to see if a persons street where the
person live allready exist. And if so display the autonumbered primary key
for that/these person that live on the same street. But the function that I
have so far only return the primary key for the last person in the
recordset.
Any idéa would be highly appreciated.
TIA!
// Niklas
Her´s the code:
===================================================
Public Function CheckDoubleAdress(strStreet As String) As Long
'****************************************************************
' Description: Check if adress data allready is registrated.
'
' Author: Niklas Östergren
' Date: 2004-11-07
' Returns: 0 if adress does NOT exist else return PersonID for
' person which is registrated on same street.
'******************************************************************
On Error GoTo Error_Handler
Dim db As DAO.Database
Dim rec As DAO.Recordset ' Holding recordset to search in.
Dim strSQL As String ' Holding SQL-string to search in.
Dim intCounter As Integer ' Holding number of persons that have same
adress
Dim strMatches As String ' Holding matched records
Dim strPersonName As String ' Holding persons complete name that live on the
same street
Set db = Currentdb()
' If strStreet don´t have any value then return 0 and exit function.
If strStreet & "" = "" Then
CheckDoubleAdress = 0
GoTo Exit_Procedure
End If
' If we get here then we know that strStreet have a valid value.
strSQL = "SELECT tblPerson.*, tblPersonAddress.* FROM tblPersonAddress "
_
& "RIGHT JOIN tblPerson ON tblPersonAddress.PersonAddressID =
tblPerson.fkPersonAddressID " _
& "WHERE tblPersonAddress.Street = " & "'" & strStreet & "'"
' Open up the recordset for selected street
Set rec = db.OpenRecordset(strSQL, dbOpenDynaset)
' Check if any record. If not return 0 else look up
' the persons that have this street registrated
If rec.RecordCount = 0 Then
CheckDoubleAdress = 0
GoTo Exit_Procedure
' Yes the street is registrated in db
Else
rec.MoveLast
intCounter = rec.RecordCount
rec.MoveFirst
' Loop throug all record and get persons complete name and DoB
Do Until rec.EOF
strPersonName = rec!FirstName & " " & rec!LastName & "
(född: " & rec!DoB & ")"
strMatches = strMatches & Chr$(10) & strPersonName
' Return persons ID-number
CheckDoubleAdress = rec!PersonID
rec.MoveNext
Loop
' Display the persons that have same adress
MsgBox "Följande " & intCounter & " person/er är registrerade på
samma gatuadress: " & vbCrLf _
& Chr$(10) & strMatches & vbCrLf & vbCrLf, vbInformation +
vbOKOnly, "Dubbletter"
End If
' Clean up
rec.Close
Set rec = Nothing
Exit_Procedure:
Exit Function
Error_Handler:
MsgBox "Ett fel har uppstått i programmet " & vbCrLf _
& "Vänligen kontakta administratören och ge dem denna
informationen: " & vbCrLf & vbCrLf _
& "Error Number " & Err.Number & ", " & Err.Description & ",
(Procedur: CheckDoubleAdress)", vbCritical, "Medlemsregister"
ErrorLog
Resume Exit_Procedure
Resume
End Function
==========================================================
I´m trying to loop throug a recordset to see if a persons street where the
person live allready exist. And if so display the autonumbered primary key
for that/these person that live on the same street. But the function that I
have so far only return the primary key for the last person in the
recordset.
Any idéa would be highly appreciated.
TIA!
// Niklas
Her´s the code:
===================================================
Public Function CheckDoubleAdress(strStreet As String) As Long
'****************************************************************
' Description: Check if adress data allready is registrated.
'
' Author: Niklas Östergren
' Date: 2004-11-07
' Returns: 0 if adress does NOT exist else return PersonID for
' person which is registrated on same street.
'******************************************************************
On Error GoTo Error_Handler
Dim db As DAO.Database
Dim rec As DAO.Recordset ' Holding recordset to search in.
Dim strSQL As String ' Holding SQL-string to search in.
Dim intCounter As Integer ' Holding number of persons that have same
adress
Dim strMatches As String ' Holding matched records
Dim strPersonName As String ' Holding persons complete name that live on the
same street
Set db = Currentdb()
' If strStreet don´t have any value then return 0 and exit function.
If strStreet & "" = "" Then
CheckDoubleAdress = 0
GoTo Exit_Procedure
End If
' If we get here then we know that strStreet have a valid value.
strSQL = "SELECT tblPerson.*, tblPersonAddress.* FROM tblPersonAddress "
_
& "RIGHT JOIN tblPerson ON tblPersonAddress.PersonAddressID =
tblPerson.fkPersonAddressID " _
& "WHERE tblPersonAddress.Street = " & "'" & strStreet & "'"
' Open up the recordset for selected street
Set rec = db.OpenRecordset(strSQL, dbOpenDynaset)
' Check if any record. If not return 0 else look up
' the persons that have this street registrated
If rec.RecordCount = 0 Then
CheckDoubleAdress = 0
GoTo Exit_Procedure
' Yes the street is registrated in db
Else
rec.MoveLast
intCounter = rec.RecordCount
rec.MoveFirst
' Loop throug all record and get persons complete name and DoB
Do Until rec.EOF
strPersonName = rec!FirstName & " " & rec!LastName & "
(född: " & rec!DoB & ")"
strMatches = strMatches & Chr$(10) & strPersonName
' Return persons ID-number
CheckDoubleAdress = rec!PersonID
rec.MoveNext
Loop
' Display the persons that have same adress
MsgBox "Följande " & intCounter & " person/er är registrerade på
samma gatuadress: " & vbCrLf _
& Chr$(10) & strMatches & vbCrLf & vbCrLf, vbInformation +
vbOKOnly, "Dubbletter"
End If
' Clean up
rec.Close
Set rec = Nothing
Exit_Procedure:
Exit Function
Error_Handler:
MsgBox "Ett fel har uppstått i programmet " & vbCrLf _
& "Vänligen kontakta administratören och ge dem denna
informationen: " & vbCrLf & vbCrLf _
& "Error Number " & Err.Number & ", " & Err.Description & ",
(Procedur: CheckDoubleAdress)", vbCritical, "Medlemsregister"
ErrorLog
Resume Exit_Procedure
Resume
End Function
==========================================================