• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 338
  • Last Modified:

outlook business contacts manager link

HI, i would like to link a contact to an existant account in VBA.
My contact is coming from excel.
I found this code in MS website but it creates a new account.
Thanks


Sub AddContactsToAccount()

Dim olApp As Outlook.Application
Dim objNS As Outlook.Namespace
Dim olFolders As Outlook.Folders
Dim bcmRootFolder As Outlook.Folder
Dim bcmAccountsFldr As Outlook.Folder
Dim bcmContactsFldr As Outlook.Folder
Dim newAcct As Outlook.ContactItem
Dim newContact1 As Outlook.ContactItem
Dim userProp As Outlook.UserProperty

Set olApp = CreateObject("Outlook.Application")
Set objNS = olApp.GetNamespace("MAPI")
Set olFolders = objNS.Session.Folders
Set bcmRootFolder = olFolders("Business Contact Manager")
Set bcmAccountsFldr = bcmRootFolder.Folders("Accounts")
Set newAcct = bcmAccountsFldr.Items.Add("IPM.Contact.BCM.Account")

newAcct.FullName = "World Wide Importers"
newAcct.FileAs = "World Wide Importers"
newAcct.Save

Set bcmContactsFldr = bcmRootFolder.Folders("Business Contacts")

Set newContact1 = bcmContactsFldr.Items.Add("IPM.Contact.BCM.Contact")
newContact1.FullName = "John Smith"
newContact1.FileAs = "John Smith"

If (newContact1.UserProperties("Parent Entity EntryID") Is Nothing) Then
    Set userProp = newContact1.UserProperties.Add("Parent Entity EntryID", olText, False, False)
    userProp.Value = newAcct.EntryID
End If

newContact1.Save
newAcct.Save

Set newAcct = Nothing
Set newContact1 = Nothing
Set bcmContactsFldr = Nothing
Set bcmAccountsFldr = Nothing
Set bcmRootFolder = Nothing
Set olFolders = Nothing
Set objNS = Nothing
Set olApp = Nothing

End Sub

Open in new window

0
erezabou
Asked:
erezabou
  • 2
1 Solution
 
Arno KosterCommented:
line 26 indeed adds a new contact to the folder.
when you want to update existing contacts, in general you should use something like

For Each Item In bcmAccountsFldr.Items
    If Item.FullName = "John Smith" Then
        If (item.UserProperties("Parent Entity EntryID") Is Nothing) Then
            Set userProp = item.UserProperties.Add("Parent Entity EntryID", olText, False, False)
            userProp.Value = newAcct.EntryID
            exit for
        end if
End If

Open in new window


to replace lines 26 up to 34
0
 
Arno KosterCommented:
whoops, the code should have been

For Each Item In bcmContactsFldr.Items
    If Item.FullName = "John Smith" Then
        If (item.UserProperties("Parent Entity EntryID") Is Nothing) Then
            Set userProp = item.UserProperties.Add("Parent Entity EntryID", olText, False, False)
            userProp.Value = newAcct.EntryID
            exit for
        end if
End If

Open in new window


you should add the line

Dim item  As Outlook.ContactItem

Open in new window


when you use option explicit.
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now