Selectively Control Updating Outlook Contact from Access

[dgreen]

In a previous posting, we got the code to export All Access Contacts to Outlook. A couple of open issues.

How do I delete an existing record and then repopulate it in Outlook? The below code is deleting the 1st record populated, not repopulating it and moving to the next record.

        If vbYes Then
            If Not TypeName(con) = "Nothing" Then
                'Full replacement of existing record
                'Delete the current record
                con.Delete
                'Populate the current record from Access.
                With olContact
                    .CustomerID = rst("Name_ID")
                    .FirstName = Nz(rst("First_Name"), "")
                    .MiddleName = Nz(rst("MI"), "")
                    .LastName = rst("Last_Name")
                    .FullName = rst("FullName")
                    .FileAs = rst("FullName")
                    .Save
                End With

The next set of issues are 1) how to identify that a specific field is different between Access and Outlook and then 2) how to let the user make a decision to change the value or not.

The specific section of code that I'm looking for help in is here.

The user has clicked a message box asking if they want to just allow Access to make the changes (Yes) or do it manually (No). They have chosen No. I need to show them every mismatched value and given them a chance to change it or trust it.

                'Selectively update values that are different between Access and Outlook
                If Not TypeName(con) = "Nothing" Then
                    With olContact
                    'If the First Name value in Outlook Contact doesn't match the Access contact then
                        If .FirstName <> rst("First_Name") Then
                            MsgBox "Change Outlook name to match Access", vbYesNo
                            If vbYes Then
                                .FirstName = rst("First_Name")
                            'If vbNo Then
                           'Leave the value alone and move on 
                          'what goes here to move to the next field to check?
                            End If
                        End If
                        .Save
                    End With

Below is the whole code if you need to see it in context. Feel free to critique the code, if you think there is a better way to organize this.

Private Sub ExportAccessContacts_Click()
    'https://social.msdn.microsoft.com/Forums/office/en-US/50c8c35e-0058-45a3-a3b1-7dd605f44e91/using-the-access-table-with-vba-in-outlook-contacts-i-want-to-export-and-import?forum=accessdev
    'https://docs.microsoft.com/en-us/office/vba/api/outlook.contactitem
    Dim OlApp As Object
    Dim olContact As Object
    On Error GoTo HandleErr
    
    Const olContactItem = 2                       'https://docs.microsoft.com/en-us/office/vba/api/outlook.olitemtype
    
    Set OlApp = CreateObject("Outlook.Application")
    
    Dim appOutlook As Outlook.Application
    Dim nms As Outlook.Namespace
    Dim fld As Outlook.MAPIFolder
    Dim itm As Object
    Dim con As Outlook.ContactItem
    Dim lngContactID As Long
    
    Dim ClickResult As VbMsgBoxResultEx
    Dim strFile As String
    
    Dim rst As Dao.Recordset
    Set rst = CurrentDb.OpenRecordset("q_Contacts_Search", dbOpenSnapshot)
    
    Set appOutlook = GetObject(, "Outlook.Application")
    Set nms = appOutlook.GetNamespace("MAPI")
    Set fld = nms.GetDefaultFolder(olFolderContacts)
    
    'Move to the first record in the table/query
    rst.MoveFirst
    
    'Continue to do the below loop until all records are either added to Outlook or have been confirmed that they were already there.
    Do Until rst.EOF
        
        lngContactID = rst("Name_ID")
        strFile = "C:\Users\" & fOSUserName() & "\Pictures\AVC_Backend\Contacts\" & rst("First_Name") & " " & rst("Last_Name") & ".png"
        Set con = fld.Items.Find("[CustomerID] = " & lngContactID)
        Set olContact = OlApp.CreateItem(olContactItem)
        
        'Give user option to use all values from Access or selectively update Outlook (one record at a time)
        MsgBox "Trust Access (Yes) or Go Slow (No)", vbYesNoCancel
        
        If vbYes Then
            If Not TypeName(con) = "Nothing" Then
                'Full replacement of existing record
                'Delete the current record
                con.Delete
                'Populate the current record from Access.
                With olContact
                    .CustomerID = rst("Name_ID")
                    .FirstName = Nz(rst("First_Name"), "")
                    .MiddleName = Nz(rst("MI"), "")
                    .LastName = rst("Last_Name")
                    .FullName = rst("FullName")
                    .FileAs = rst("FullName")
                    .Save
                End With
                rst.MoveNext

            Else
                'Create a new record if the Name_ID isn't already in the default Outlook Contacts folder.
                With olContact
                    .CustomerID = rst("Name_ID")
                    .FirstName = Nz(rst("First_Name"), "")
                    .MiddleName = Nz(rst("MI"), "")
                    .LastName = rst("Last_Name")
                    .FullName = rst("FullName")
                    .FileAs = rst("FullName")
                    End If
                    .Save
                End With
                rst.MoveNext
                'Start over again with the next record in the table/query
            End If

            If vbNo Then
                'Selectively update values that are different between Access and Outlook
                If Not TypeName(con) = "Nothing" Then
                    With olContact
                        If .FirstName <> rst("First_Name") Then
                            MsgBox "Change Outlook name to match Access", vbYesNo
                            If vbYes Then
                                .FirstName = rst("First_Name")
                            'If vbNo Then
                            'what goes here to move to the next field to check?
                            End If
                        End If
                        .Save
                    End With
                    rst.MoveNext

                Else
                    'Create a new record if the Name_ID isn't already in the default Outlook Contacts folder.
                    With olContact
                        .CustomerID = rst("Name_ID")
                        .FirstName = Nz(rst("First_Name"), "")
                        .MiddleName = Nz(rst("MI"), "")
                        .LastName = rst("Last_Name")
                        .FullName = rst("FullName")
                        .FileAs = rst("FullName")
                        End If
                        .Save
                    End With
                    'Move to the next record
                    rst.MoveNext
                End If
            End If
        End If
    Loop
    'clean up
    Set olContact = Nothing
    Set con = Nothing
    Set fld = Nothing
    Set nms = Nothing
    Set appOutlook = Nothing
    
    rst.Close
    Set rst = Nothing
    
    MsgBox "Done"
    
HandleExit:
    Exit Sub
    
HandleErr:
    Select Case Err.Number
        Case Else
            MsgBox Err.Number & vbCrLf & Err.Description
            Resume HandleExit
            Resume
    End Select
End Sub

 

[bastanu]

I wouldn't go with either option you have above. I would leave the current code the way you have it now to add new contacts from Access and create a new button to Edit/Compare contacts. In that I would do what I suggested in your original post and that is link the Outlook contacts and then populate a local front-end table (that you empty every time before populating) with the fields of the common contacts, open a form that shows (for each common Name_ID in Outlook and Access) side by side the field values and let the user select in a combo what they want to do (Ignore,Update Outlook from Access, Update Access from Outlook). Once they finished they can click an Update Contacts button that will do the updating accordingly.

Cheers,
Vlad

 

[Gasman]

In your previous thread you had to create an outlookItem to create a new contact?

 Set olContact = OlApp.CreateItem(olContactItem)

 

[dgreen]

you had to

I'm not sure if I had to, but I did have it. I definitely don't understand all of the whys.

 

[Gasman]

OK, I missed the fact you do have it here, after the Find.

You need to walk through the code line by line with F8 and work out what is happening. That is how I find out what I have done wrong when it does not stare you in the face.?