0
341
ViewsOutlook Shared Contacts copied to MyContacts
I am trying to copy Outlook Shared Contacts into a folder under MyContacts. I am looking for an easy solution for my team outside of using an Import Wizard or physically copy/paste due to the computer challenged. I have been successful in doing this from MyContacts/Contacts to MyContacts/Another_Folder but can't seem to copy from a Shared Contact folder.
I am running a macro from Excel so that all users can just run the Excel macro and it will modify their Outlook instead of having everyone Allow macros in Outlook.
Current running code is here:
Sub CopyContacts()
Dim ContactItem As Outlook.ContactItem
Dim Name As Outlook.Namespace
Dim Folder As Outlook.Folder
Dim Item As Object
Set Name = Outlook.GetNamespace("MAPI")
Set Folder = Name.GetDefaultFolder(olFolderContacts)
For Each Item In Folder.Items
If Item.Class = olContact Then
Set ContactItem = Item.Copy
ContactItem.Move Folder.Folders("Another_Folder")
End If
Next
End Sub
I would like to run an Excel Macro to copy all the contents from Shared Contacts John Doe's folder to Another_Folder.
I would be great if the Macro deleted all the contents from Another_Folder before the copy function.
1 answers
Answer question0
You can use the NameSpace.GetSharedDefaultFolder method which returns a Folder object that represents the specified default folder for the specified user. This method is used in a delegation scenario, where one user has delegated access to another user for one or more of their default folders (for example, their shared Calendar folder).
Sub ResolveName()
Dim myNamespace As Outlook.NameSpace
Dim myRecipient As Outlook.Recipient
Dim CalendarFolder As Outlook.Folder
Set myNamespace = Application.GetNamespace("MAPI")
Set myRecipient = myNamespace.CreateRecipient("John Doe")
myRecipient.Resolve
If myRecipient.Resolved Then
Call ShowContacts(myNamespace, myRecipient)
End If
End Sub
Sub ShowContacts(myNamespace, myRecipient)
Dim ContactsFolder As Outlook.Folder
Set ContactsFolder = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderContacts)
ContactsFolder.Display
End Sub