批量导出Outlook所有联系人到vcard文件

Outlook2010中选择“开发工具-->Visual Basic-->模块”插入一个模块 （Outlook2007中选择“工具->宏->宏， 创建一个新的宏”）， 

输入以下代码，点击绿色的执行按钮，即可在d:/Contacts目录下看到导出的所有联系人的vcard文件。

Sub ExportVcards（）

    Dim MyContacts As Outlook.MAPIFolder

    Dim ContItem As Outlook.ContactItem

    Dim FileName As String

    Set MyContacts = application.GetNamespace（"MAPI"）.GetDefaultFolder（olFolderContacts）

    '导出Outlook联系人目录下的联系人到":/Contacts/联系人"目录

    On Error Resume Next

    Dim ofso

Set oFso = CreateObject（"Scripting.FileSystemObject"）

oFso.CreateFolder （"d:/Contacts”）

    oFso.CreateFolder （"d:/Contacts/联系人"）

    For Each ContItem In MyContacts.Items

        FileName = "d:/Contacts/联系人/" & ContItem.FileAs & ".vcf"

        ContItem.SaveAs FileName， olVCard

    Next

    '导出联系人目录下所有文件夹中的联系人

    For i = 1 To MyContacts.Folders.Count

        Set Folder = MyContacts.Folders（i）

        On Error Resume Next

        Set oFso = CreateObject（"Scripting.FileSystemObject"）

        oFso.CreateFolder （"d:/Contacts/" & Folder）

        For Each ContItem In MyContacts.Folders（i）.Items

            FileName = "d:/Contacts/" & Folder & "/" & ContItem.FileAs & ".vcf"

            ContItem.SaveAs FileName， olVCard

        Next

    Next i

End Sub