Need VBA script to export and import public folder contact list

Posted on 2004-11-10
Medium Priority
Last Modified: 2012-08-14
Hello all,

I currently work in an organization that has contact list in a public folder. The biggest problem with this is that synchronization cannot be done on public folders to replicate newly entered contacts. The only way that contacts can be viewed is by going through OWA. I have a couple of users that have PDAs - so being able to sync with a contact list would be a better solution.

I am wondering if anyone has a snippet of vb code that could be used to export the contacts from the public folder then import this data to a private contacts folder.


Question by:slangdell
  • 2
LVL 76

Accepted Solution

David Lee earned 1000 total points
ID: 12580940
Hi, Shawna.

I believe I can provide what you're looking for.  I'll post it within the next 24 hours.
LVL 76

Expert Comment

by:David Lee
ID: 12586280
Here's the code for what you want to do.  I tested it in my Exchange/Outlook environment and it works fine.  Right now it just copies all the contacts from the source folder to the destination folder.  If the destination folder already contains any of the contacts being copied, then this process will create a second copy of those contacts.  That's probably not what you want to happen.  There are two ways around this.  One, delete all the contact from the destination folder each time before running this code.  You can do that manually or the code could be modified to do it for you.  Two, modify the code to perform a true synchronization.  That's more complicated than the former solution, but certainly doable.  The code here is straight VB and is intended to be run from outside Outlook.

Hope this helps.

-- BDF

Private Sub Command1_Click()
    Dim olApp As New Outlook.Application, _
        olNS As Outlook.NameSpace, _
        olSourceFolder As MAPIFolder, _
        olDestinationFolder As MAPIFolder, _
        olItems As Outlook.Items, _
        olContact As ContactItem, _
        olContactCopy As ContactItem, _
        intCounter As Integer
    Set olNS = olApp.GetNamespace("MAPI")
    'Replace Outlook below with your profile name
    olNS.Logon "Outlook"
    'Replace the path below with the path to the source folder
    Set olSourceFolder = OpenMAPIFolder("\Public Folders\All Public Folders\EEFolders\TestContacts")
    'Replace the path below with the path to the destination folder
    Set olDestinationFolder = OpenMAPIFolder("\Mailbox - BlueDevilFan\MyContacts")
    Set olItems = olSourceFolder.Items
    For Each olContact In olItems
        Set olContactCopy = olContact.Copy
        olContactCopy.Move olDestinationFolder
    Set olContact = Nothing
    Set olContactCopy = Nothing
    Set olSourceFolder = Nothing
    Set olDestinationFolder = Nothing
    Set olItems = Nothing
    Set olNS = Nothing
    Set olApp = Nothing
End Sub

' Credit where credit is due.  The code below is not mine.  I picked it up somewhere on the internet.  I don't remember
' where or who wrote it, but whoever the author is deserves the credit, not me.
Function OpenMAPIFolder(ByVal szPath As String) As Outlook.MAPIFolder
    Dim app As New Outlook.Application
    Dim ns As Outlook.NameSpace
    Dim flr As Outlook.MAPIFolder
    Dim szDir As String
    Dim i As Long
    Set app = New Outlook.Application

    If Left(szPath, Len("\")) = "\" Then
        szPath = Mid(szPath, Len("\") + 1)
        Set flr = app.ActiveExplorer.CurrentFolder
    End If

    While szPath <> ""
        i = InStr(szPath, "\")

        If i Then
            szDir = Left(szPath, i - 1)
            szPath = Mid(szPath, i + Len("\"))
            szDir = szPath
            szPath = ""
        End If

        If flr Is Nothing Then
            Set ns = app.GetNamespace("MAPI")
            Set flr = ns.Folders(szDir)
            Set flr = flr.Folders(szDir)
        End If


    Set OpenMAPIFolder = flr
End Function

Author Comment

ID: 12599217
Thanks for this. I am in the middle of a project and haven't had a chance to try it out. When I do, I will update and close this out!



Featured Post

Get quick recovery of individual SharePoint items

Free tool – Veeam Explorer for Microsoft SharePoint, enables fast, easy restores of SharePoint sites, documents, libraries and lists — all with no agents to manage and no additional licenses to buy.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes how to import Lotus Notes Contacts into Outlook 2016, 2013, 2010 and 2007 etc. with a few manual steps. You can easily export and migrate Lotus Notes contacts into Microsoft Outlook without having to use any third party tools.
MS Outlook undoubtedly is the most widely used email client.Its user-friendliness, cost effectiveness, and availability with Microsoft Office Suite make it the most popular email application.  Its compatibility with Microsoft applications like Exch…
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…
Suggested Courses

850 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question