VB script copy attribute from one contact to another matched by email

What if both have content in Notes, but not identical?

---

»bp

Also, there are several different email address fields in the Contact object, which one do you want to match on?

---

»bp

Morning Bill

All the notes fields for the contacts in ‘sub folder 2’ are empty. We wish to transfer any notes left against contacts in sub folder 1 to sub folder 2 if they match.

The primary ‘email’ field I would like to match against.

Thanks.

Didn't get to this Friday but will work something up in the next couple of days...

---

»bp

Play around with this and see if it does what you want.  Edit the "paths" to the two contact folders in near the top.

Option Explicit

Sub MergeContactNotes()
    Dim SourceFolder As Outlook.Folder
    Dim DestinationFolder As Outlook.Folder
    Dim SourceItem As Object
    Dim SourceContact As ContactItem
    Dim DestinationItems As Items
    Dim DestinationItem As Object
    Dim DestinationContact As ContactItem
    
    Set SourceFolder = GetFolderPath("\\Bills Folders\EE29135033\Source")
    Set DestinationFolder = GetFolderPath("\\Bills Folders\EE29135033\Destination")
    
    For Each SourceItem In SourceFolder.Items
        If (SourceItem.Class = olContact) Then
            Set SourceContact = SourceItem
            If SourceContact.Body <> "" Then
                Set DestinationItems = DestinationFolder.Items.Restrict("[Email1Address] = '" & SourceContact.Email1Address & "'")
                For Each DestinationItem In DestinationItems
                    Set DestinationContact = DestinationItem
                    DestinationContact.Body = SourceContact.Body
                    DestinationContact.Save
                Next
            End If
        End If
    Next
    
End Sub

Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
    Dim oFolder As Outlook.Folder
    Dim FoldersArray As Variant
    Dim i As Integer
        
    On Error GoTo GetFolderPath_Error
    If Left(FolderPath, 2) = "\\" Then
        FolderPath = Right(FolderPath, Len(FolderPath) - 2)
    End If
    FoldersArray = Split(FolderPath, "\")
    Set oFolder = Application.Session.Folders.item(FoldersArray(0))
    If Not oFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)
            Dim SubFolders As Outlook.Folders
            Set SubFolders = oFolder.Folders
            Set oFolder = SubFolders.item(FoldersArray(i))
            If oFolder Is Nothing Then
                Set GetFolderPath = Nothing
            End If
        Next
    End If
    Set GetFolderPath = oFolder
    Exit Function
        
GetFolderPath_Error:
    Set GetFolderPath = Nothing
    Exit Function
End Function

Select allOpen in new window

---

»bp

Thanks for this Bill

I don't get any errors when i run the script however i have a contact that matches on emailaddress in my main folder and subfolder1 but the notes are not tansferred. Is it possible to translate it into VBS?

VBS isn't going to help, it would basically have to open or connect to Outlook (there is no native access to PST files in VBS) and then use automation to execute the same command we are executing in VBA.

I would suggest debugging through the code line by line to determine what might need adjustment.  Find out if it saw the contact involved in the outer loop against the Source folder, and if so then you might compare the email address to the one you think matches in the destination folder.  Are they in the same email "slot" (outlook has three) for email, is the spelling and capitalization the same, etc.

If you want to export the two contacts to separate files or something perhaps I could take a look at them here, but not sure how well that will work.

---

»bp