Copy Outlook Shared Contacts to My Contacts via Excel VBA

[tpthatsme]

Scenario: Another user on Microsoft Exchange has shared an Outlook Contact folder with me and I would like to create an Excel VBA macro to copy the content of that folder to another "local" folder in my Outlook Contacts.

I have written a VBA solution that is very close to what I want but it copies the contents from my default folder to a subfolder.

Sub CopyContacts()

Dim ol_ContactItem As Outlook.ContactItem
Dim ol_Name As Outlook.Namespace
Dim ol_Folder As Outlook.Folder
Dim ol_SharedFolder As Outlook.Folder
Dim ol_Item As Object
Dim ol_Recipient As Outlook.Recipient

Set ol_Name = Outlook.GetNamespace("MAPI")
Set ol_Recipient = ol_Name.CreateRecipient("John Doe")
ol_Recipient.Resolve

Set ol_Folder = ol_Name.GetDefaultFolder(olFolderContacts)
Set ol_SharedFolder = ol_Name.GetSharedDefaultFolder(ol_Recipient, olFolderContacts)

    For Each ol_Item In ol_Folder.Items

        If ol_Item.Class = olContact Then

        Set ol_ContactItem = ol_Item.Copy
        ol_ContactItem.Move ol_Folder.Folders("Another_Folder")

        End If

    Next

End Sub

In this example I think I have the right syntax for identifying the Recipient, but I can't seem to get the right syntax to copy the content to my folder.
When I use the following in my For statement, it fails.

For Each ol_Item In ol_SharedFolder.Items

Anyone have any suggestions?