Private Sub cboClientContactID_NotInList(NewData As String, Response As Integer)
10 On Error GoTo PROC_ERR
20 PushCallStack "frmInquiries: cboClientContactID_NotInList"
' Adds a new client contact if they don't already exist
30 Dim fName As String, lName As String, ContactID As Long, strEmail As String
40 Dim strClient As String
50 Dim lNameStart As Long
60 Dim rsInq As DAO.Recordset
70 If Me.chkInternal = True Then
80 MsgBox "You must choose a department from the list provided.", vbInformation, "Unknown Contact"
90 Response = acDataErrContinue
100 Else
110 If MsgBox("The name you typed is not on the contact list for this client. Would you like to add it?", vbYesNo + vbQuestion, _
"Add " & NewData & "?") = vbYes Then
120 Response = acDataErrAdded
130 If Me.cboClientID = 131 Then
' Client is not known
140 MsgBox "You must select a client before adding " & NewData & " as a client contact.", vbOK + vbInformation, _
"Unknown Contact"
150 Me.cboClientID.SetFocus
160 Me.cboClientContactID.Dropdown
170 Response = acDataErrContinue
180 Else
' Client is known
190 lNameStart = InStrRev(NewData, " ")
200 If lNameStart = 0 Then ' no spaces in the new data, so first and last name cannot be parsed
210 MsgBox "Both a first and last name are required to add a new client contact.", vbInformation, "Save New Contact"
220 Response = acDataErrContinue
230 Else
' A space exists, so make the last name all text to the right of the last space, and the firstname
' everything to the left of it.
24 lName = right(NewData, Len(NewData) - lNameStart)
250 fName = Trim(Left(NewData, lNameStart))
260 If Me.chrSenderEmail = "Not Found" Then
' Email address could not be scraped from the original email message
270 strEmail = InputBox("Enter " & NewData & "'s email address:", "Save new Contact", _
"Email address...")
280 Do While Not strEmail Like "*@*.*"
290 If strEmail = "" Then ' User Canceled the input box for the email address
300 MsgBox "No email address saved for " & NewData & ".", vbInformation, "Save New Contact"
310 strEmail = "No Email Address"
320 Exit Do
330 End If
340 strEmail = InputBox("The email is not in a valid format." & vbCrLf & vbCrLf & _
"Please re-enter " & NewData & "'s email address:", "Email Not Found")
350 Loop
360 Response = acDataErrAdded
370 Else
' Email was scraped from the original email, so confirm that it belongs to the new client contact.
380 If MsgBox("Is " & NewData & "'s email address " & Me.chrSenderEmail & "?", vbYesNo + vbQuestion, _
"Confirm Email Address") = vbNo Then
390 strEmail = InputBox("Enter " & NewData & "'s email address:", "Enter New Address")
400 Do While Not strEmail Like "*@*.*"
410 If strEmail = "" Then ' User Canceled the input box for the email address
420 MsgBox "No email address saved for " & NewData & ".", vbInformation, "Save New Contact"
430 strEmail = "No Email Address"
440 Exit Do
450 End If
460 strEmail = InputBox("The email is not in a valid format." & vbCrLf & vbCrLf & _
"Please re-enter " & NewData & "'s email address:", "Email Not Found")
470 Loop
480 Else
490 strEmail = Me.chrSenderEmail
500 End If
510 Response = acDataErrAdded
520 End If
' We now have a valid clientID, first name, last name and email address - add the client contact to the table
530 If db Is Nothing Then Set db = CurrentDb
540 Set rs = db.OpenRecordset("tblClientContacts")
550 With rs
560 .AddNew
570 !chrClientContactFirstName = fName
580 !chrClientContactLastName = lName
590 !lngClientID = Me.cboClientID
600 !chrClientContactEmail = strEmail
610 .Update
620 .FindFirst "ChrClientContactEmail = '" & strEmail & "'"
630 ContactID = !lngClientContactID
640 .Close
650 End With
660 Set rs = db.OpenRecordset("Select chrClient from tblClients where lngClientID = " & Me.cboClientID)
670 With rs
680 .MoveFirst
690 strClient = !chrClient
700 .Close
710 End With
720 MsgBox fName & " " & lName & " has been added to the list of available client contacts for " & _
strClient & ".", vbInformation, "New Client Contact Added"
'Update all existing unknown records that have the same send email account
730 Set rs = Nothing
740 Set rsInq = db.OpenRecordset("SELECT * from tblInquiries where chrSenderEmail = '" & strEmail & _
"' and lngClientContactId is null;")
750
760 If rsInq.RecordCount > 0 Then
770 With rsInq
780 .MoveFirst
790 Do
800 If Not !lngInquiryID = Me.lngInquiryID Then
810 .Edit
820 !lngClientContactID = ContactID
830 !blnClientContactVerified = True
840 .Update
850 End If
860 .MoveNext
870 Loop Until .EOF
880 End With
890 End If
900 rsInq.Close
910 End If
920 End If
930 Else
940 MsgBox "Please select a contact from the list.", vbOK + vbInformation, "Unknown Contact"
950 Me.cboClientContactID = ""
960 Me.cboClientContactID.Dropdown
970 Response = acDataErrContinue
980 End If
990 Set rs = Nothing
1000 Set db = Nothing
1010 End If
PROC_EXIT:
9000 PopCallStack
9100 Exit Sub
PROC_ERR:
9200 GlobalErrHandler
9300 Resume Next
End Sub