erezabou
asked on
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
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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
when you want to update existing contacts, in general you should use something like
Open in new window
to replace lines 26 up to 34