Question : Run checks before Update query

Hi,

I know the below code is a bit of a mess, however i have been working on it for a few hours now and still seem to be getting nowhere. I have now started to get an ODBC fail on the .update. I have tried to annotate my code so that you can try and work out what i'm trying to do. I hope someone can point me in the right direction.

Thanks
Tom

Code Snippet:

         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:

           
           
             Private Sub cmdSaveContact_Click()
'On Error GoTo Err_Handler
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strUser As String
Dim strUpdatePrimary As Integer


''''Check if user has checked that the contact is to be the Primary Contact
If Me.ChkPrimary_contact = True Then
MsgBox "check for existing primary"

  strSQL = "SELECT * From tbl_syscontacts WHERE tbl_syscontacts.contact_primary=True AND tbl_syscontacts.company_id=" & Me.company
  
    Set db = CurrentDb
    Set rs = db.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges, dbOptimistic)

  If rs.EOF Then
    MsgBox "Primary does not exist"

''''Go Ahead and add the new contact as a primary contact
rs.AddNew
        rs("company_id") = Me.company
        rs("contact_title") = Me.cboTitle
        rs("contact_fname") = Me.contact_fname
        rs("contact_lname") = Me.contact_lname
        rs("job_title") = "JOB TITLE"
        rs("department") = "Department"
        rs("email") = Me.email
        rs("work_phone") = Me.work_phone
        rs("fax_number") = Me.fax_number
        rs("contact_primary") = Me.ChkPrimary_contact
        rs.Update
  Else

    MsgBox "Record exists"

''''Ask if the user wants to make the new contact the primary contact

    strUpdatePrimary = MsgBox("This company already has a Primary Contact assigned.  Do you want to make this new contact the Primary Contact?", vbYesNo, "Existing Primary Contact")
        If strUpdatePrimary = 6 Then
        
'''' update old primary contact and then add the new one.

        rs.Edit
        rs("contact_primary") = False
        rs.Update
   
Set rs = Nothing

strSQL = "SELECT * From tbl_syscontacts"
  
    Set rs = db.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges, dbOptimistic)
  
rs.AddNew
        rs("company_id") = Me.company
        rs("contact_title") = Me.cboTitle
        rs("contact_fname") = Me.contact_fname
        rs("contact_lname") = Me.contact_lname
        rs("job_title") = "JOB TITLE"
        rs("department") = "Department"
        rs("email") = Me.email
        rs("work_phone") = Me.work_phone
        rs("fax_number") = Me.fax_number
        rs("contact_primary") = Me.ChkPrimary_contact
        rs.Update
  
End If

'Else
MsgBox "Continue with code"
End If

''''The user has not checked the contact to be primary - go ahead and just add it

Add_New:
    
    strSQL = "select * from tbl_syscontacts"
    

    Set db = CurrentDb
    Set rs = db.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges, dbOptimistic)

        rs.AddNew
        rs("company_id") = Me.company_id
        rs("contact_title") = Me.cboTitle
        rs("contact_fname") = Me.contact_fname
        rs("contact_lname") = Me.contact_lname
        rs("job_title") = "JOB TITLE"
        rs("department") = "Department"
        rs("email") = Me.email
        rs("work_phone") = Me.work_phone
        rs("fax_number") = Me.fax_number
        rs("contact_primary") = Me.ChkPrimary_contact
        rs.Update
        
        rs.Close
        
        Me.cboTitle = Null
        Me.contact_fname = Null
        Me.contact_lname = Null
        Me.work_phone = Null
        Me.fax_number = Null
        Me.email = Null
        Me.ChkPrimary_contact = False
            
        
End If
  
    db.Close
        
    Set rs = Nothing
    Set db = Nothing

Me.lbContacts.Requery

Me.Refresh

           
         

Open in New Window

Select All

Answer : Run checks before Update query

Hi Tom

It appears that if ChkPrimary_Contact is checked then you are actually adding the record twice. If there is an existing primary contact for the company, then the new record is added at lines 56-67, and if not, it is added at lines 23-34. Then, no matter what has happened before, a new record is added at lines 85-96. If this is a primary contact then you will be creating a duplicate record.

Also, if there is already a primary contact for the company and you do not answer "Yes" to the question at line 41, then the newly added record at 56-67 will be a second primary contact. Presumably this is not what you want.

It seems to me you would be better to ascertain whether or not the new contact should be the primary, and then add the record just once - see the revised code attached below.

Good luck!
--
Graham

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:

           
           
             Private Sub cmdSaveContact_Click()
On Error GoTo Err_Handler
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim NewContactIsPrimary As Boolean

NewContactIsPrimary = Me.ChkPrimary_contact

''''Check if user has checked that the contact is to be the Primary Contact
MsgBox "check for existing primary"

  strSQL = "SELECT * From tbl_syscontacts WHERE tbl_syscontacts.contact_primary=True " _
    & "AND tbl_syscontacts.company_id=" & Me.Company
  
  Set db = CurrentDb
  Set rs = db.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges, dbOptimistic)

  If rs.EOF Then

'''' No primary contact already exists for this company.
    
    If Not NewContactIsPrimary Then
'''' Ask if the user wants to make the new contact the primary contact
      If MsgBox("This company does not have a Primary Contact assigned." & vbCrLf _
            & "Do you want to make this new contact the Primary Contact?", _
            vbYesNo, "No Existing Primary Contact") = vbYes Then
        NewContactIsPrimary = True
      End If
    End If
  
  Else

'''' Primary contact already exists for this company.

    If NewContactIsPrimary Then
'''' Ask if the user wants to change the primary contact to the new contact
      If MsgBox("This company already has a Primary Contact assigned." & vbCrLf _
            & "Do you want to make this new contact the Primary Contact?", _
            vbYesNo, "Existing Primary Contact") = vbYes Then
'''' Turn off contact_primary flag in existing record
        rs.Edit
        rs("contact_primary") = False
        rs.Update
        NewContactIsPrimary = True
      End If
    End If

  End If

'''' NewContactIsPrimary is now appropriately set
'''' Go ahead and add the new record

  rs.AddNew
    rs("company_id") = Me.Company
    rs("contact_title") = Me.cboTitle
    rs("contact_fname") = Me.contact_fname
    rs("contact_lname") = Me.contact_lname
    rs("job_title") = "JOB TITLE"
    rs("department") = "Department"
    rs("email") = Me.Email
    rs("work_phone") = Me.work_phone
    rs("fax_number") = Me.fax_number
    rs("contact_primary") = NewContactIsPrimary
  rs.Update

'''' Reset form controls
        
  Me.cboTitle = Null
  Me.contact_fname = Null
  Me.contact_lname = Null
  Me.work_phone = Null
  Me.fax_number = Null
  Me.Email = Null
  Me.ChkPrimary_contact = False
            
  Me.lbContacts.Requery

Proc_Exit:
  On Error Resume Next
  
  If Not rs Is Nothing Then
    rs.Close
    Set rs = Nothing
  End If
    
  Set db = Nothing ' don't close CurrentDb - it has no effect

Exit Sub

Err_Handler:

  MsgBox Err.Description, vbExclamation, "Error adding new contact"
  Resume Proc_Exit
End Sub

           
         

Open in New Window

Select All