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

  Outlook使用时间久了，通讯录里面会存有很多经常联系的联系人信息（邮箱、电话、手机等）。当你换手机时，有时候很希望能把这些联系人的信息导入到手机通讯录中，但是一般Android的手机只可以导入vcard的名片。虽然Outlook可以将单个的联系人导出为vcard文件，但是对于大量的联系人，一个一个导出还是相当麻烦。经过一段时间的摸索，终于找到了批量导出Outlook所有联系人到vcard文件的方法，该方法需要使用vba的脚本，首先需要在Outlook2010中“文件-->选项-->自定义功能区”打开“开发工具”选项卡（Outlook其他版本可以百度搜索怎么打开“开发工具”或“宏”选项卡）。

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