Hi all,
I hit my head against a wall all day yesterday with this one. All of the following code is (or at least seems to be) working except the last If statement. This statement's goal is that when entering a buyer into a subform (RecordSource = SalesBuyers) on the Sales form the Contact form will open if all of the following are true:
1. They ever looked with AER (LookingContacts table)
2. Ended up buying with another agency (Current record of open Sales form has BuyerAgencyID <> 1 or is null)
3. Entered as a buyer in the Contact_Status table (StatusID = 1)
4. Entered as a past buyer in the Contact_Status table (StatusID = 6)
The Contact form is not opening.
I have checked and doublechecked and then recreated another buyer with the required conditions just to make sure:
Contact I'm testing has "buyer" (StatusID=1) and "past buyer" (StatusID=6) entered as status in the table ContactStatus. The contact is also entered in the LookingContacts table hooking him to a LookingID. It makes no difference whether I make the AgencyID null or another agency. It does work if the AgencyID is AER--the case where it shouldn't open anyways.
The code is under: 'If looked with AER and bought with another realty and "Buyer" and "Past Buyer" were entered as statuses, open contact form with directions
Help!
Connie
Private Sub ContactID_BeforeUpdate(Cancel As Integer)
'set up Error Handler
On Error GoTo Proc_Err
'~~~~~~~~~~~~~~~~~~~~~~
Dim lngLooking As Long
Dim lngBEntered As Long
Dim lngLookingID As Long
Dim lngPBEntered As Long
Dim lngL As Long
'Prevent data from being changed accidentally because user thinks they are searching
'Message if data is being changed on an old record
If Me.NewRecord = False Then
Dim msg, Style, Title, Response
msg = "Did you really intend to change the contact of this listing?"
Style = vbYesNo + vbDefaultButton2
Title = "Changing Address?"
Response = MsgBox(msg, Style, Title)
If Response = vbNo Then
Me.Undo
MsgBox "Use Ctrl F to find."
Exit Sub
End If
If Response = vbYes Then
End If
End If
'Open Contact form if 'buyer' or 'past buyer' might need to be deleted from status and have directions on the top of Contact form
'Create variables
'Set value of lngBEntered = -1 on if status of "buyer" was entered in Contact form
If (DLookup("StatusID", "Contact_Status", "ContactID = " & Me.ContactID) = 1) Then
lngBEntered = -1
Else: lngBEntered = 0
End If
'Set value of lngPBEntered if status of "past buyer" was entered in Contact form (past buyer entered)
If (DLookup("StatusID", "Contact_Status", "ContactID = " & Me.ContactID) = 6) Then
lngPBEntered = -1
Else: lngPBEntered = 0
End If
'Set value of lngLooking = -1 if looked with AER and bought with another realty (past buyer derived)
lngL = Nz(DLookup("LookingID", "LookingContacts", "ContactID = " & Nz([ContactID], 0)), 0)
If (lngL <> 0) Then
If ((IsNull(Me.Parent.Form.BuyerAgencyID)) Or (Me.Parent.Form.BuyerAgencyID <> 1)) Then
lngLooking = -1
Else: lngLooking = 0
End If
End If
'Open appropriate forms with messages
'If not entered in a LookingEvent w AER and "buyer" was typed in as status open contact form with directions
If ((lngLooking = 0) And (lngBEntered = -1)) Then
DoCmd.OpenForm "Contacts"
Forms!Contacts.Recordset.FindFirst "ContactID = " & Forms![Sales]![sub_SoldBuyersSales].Form![ContactID]
Forms!Contacts.WhyOpenedMsg.Caption = "Remove status of Buyer unless he/she is continuing to look." _
& vbNewLine & "Directions under email section"
Forms!Contacts.WhyOpenedMsg.Visible = True
End If
'If entered in a LookingEvent w AER and bought with another realty AND Did not have "buyer" typed in as a status _
'AND they are not entered as a past buyer, open contact form
'with directions ask re past buyer.
If ((lngLooking = -1) And (lngBEntered = 0) And (lngPBEntered = 0)) Then
DoCmd.OpenForm "Contacts"
Forms!Contacts.Recordset.FindFirst "ContactID = " & Forms![Sales]![sub_SoldBuyersSales].Form![ContactID]
Forms!Contacts.WhyOpenedMsg.Caption = "This buyer has looked previously with AER." _
& vbNewLine & "Enter status of 'Past buyer' if appropriate"
Forms!Contacts.WhyOpenedMsg.Visible = True
End If
'If looked with AER and sold with another realty AND "buyer" was typed in as a status open contact form with directions _
'AND "Past buyer" is not already entered.
If ((lngLooking = -1) And (lngBEntered = -1) And (lngPBEntered = 0)) Then
DoCmd.OpenForm "Contacts"
Forms!Contacts.Recordset.FindFirst "ContactID = " & Forms![Sales]![sub_SoldBuyersSales].Form![ContactID]
Forms!Contacts.WhyOpenedMsg.Caption = "You'll probably need to do two things:" _
& vbNewLine & "1. Remove status 'Buyer' unless he/she is continuing to look for property" _
& vbNewLine & "2. Enter status of 'Past buyer' if needed since this buyer has looked previously with AER. "
Forms!Contacts.WhyOpenedMsg.Visible = True
End If
'If looked with AER and bought with another realty and "Buyer" and "Past Buyer" were entered as statuses, open contact form with directions
If (lngLooking = -1) And (lngBEntered = -1) And (lngPBEntered = -1) Then
DoCmd.OpenForm "Contacts"
Forms!Contacts.Recordset.FindFirst "ContactID = " & Forms![Sales]![sub_SoldBuyersSales].Form![ContactID]
Forms!Contacts.WhyOpenedMsg.Caption = "Remove status 'Buyer' unless he/she is continuing to look for property"
Forms!Contacts.WhyOpenedMsg.Visible = True
End If
Proc_Exit:
Exit Sub ' or Exit Function
Proc_Err:
MsgBox Err.Description, , _
"ERROR " & Err.Number _
& " ContactID_BeforeUpdate"
Resume Proc_Exit
'if you want to single-step code to find error, CTRL-Break at MsgBox
'then set this to be the next statement by right-clicking on Resume Statement, then press F8 to execute one line at a time
Resume
End Sub
Tidak ada komentar:
Posting Komentar