如何用Outlook VBA批量导出多个联系人的照片和信息

展望解决方案 2025 年 9 月 29 日

如果要将联系人的照片和主要信息批量提取到本地磁盘的文件夹中，则需要使用Outlook VBA。本文将详细教大家如何实现。

Outlook 允许您通过“导入和导出”功能导出联系人信息。您可以转到“文件”>“打印”>“导入”>“导出到文件”。

但是，此功能不允许您导出联系人照片。因此，如果您想同时提取联系信息和照片，则必须重新使用 Outlook VBA。以下是将联系人照片保存到指定的本地文件夹并将联系人信息提取到文本文件中的VBA代码和步骤。

批量导出多个联系人的照片和信息

首先，启动 Outlook 并按“Alt + F11”键按钮。
然后您将可以访问 VBA 编辑器。现在您应该打开一个未使用的模块或通过“插入”>“模块”创建一个新模块。
随后，将以下 VBA 代码复制并粘贴到新模块中。

Sub BatchExportContactPhotosandInformation()
    Dim objContacts As Outlook.Items
    Dim objContact As ContactItem
    Dim strContactInfo As String
    Dim objFileSystem As Object
    Dim objTextfile As Object
    Dim objAttachments As Attachments
    Dim objAttachment As Attachment
    Dim strName As String
 
    'Specify the contacts in the default contact folder
    Set objContacts = Outlook.Application.Session.GetDefaultFolder(olFolderContacts).Items
 
    For Each objContact In objContacts
        If TypeOf objContact Is ContactItem Then
           'Get the contact's primary informtaion
           strContactInfo = "Name: " & objContact.FullName & vbCrLf & "Email: " & objContact.Email1Address & vbCrLf & "Company: " & objContact.Companies & vbCrLf & "Job Title: " & objContact.JobTitle & vbCrLf & "Business Address: " & objContact.BusinessAddress & vbCrLf & "Business Phone: " & objContact.BusinessTelephoneNumber
           'Create a Text file
           Set objFileSystem = CreateObject("Scripting.FileSystemObject")
           'You can change the folder path as per your needs
           Set objTextfile = objFileSystem.CreateTextFile("C:\Outlook Contacts\" & objContact.FullName & ".txt", True)
           objTextfile.WriteLine (strContactInfo)
 
           'Save the contact photos
           If objContact.Attachments.Count > 0 Then
              Set objAttachments = objContact.Attachments
              For Each objAttachment In objAttachments
                  If InStr(LCase(objAttachment.filename), "contactpicture.jpg") > 0 Then
                     strName = objContact.FullName & ".jpg"
                     objAttachment.SaveAsFile ("C:\Outlook Contacts\" & strName)
                  End If
              Next
           End If
       End If
    Next
End Sub

请注意： 以上代码将导出默认联系人文件夹中联系人的照片和信息。您可以更改指定的联系人。

如果要导出当前打开文件夹中联系人的照片和信息，则应将“Set objContacts = ...”替换为：

Set objContacts = Outlook.Application.ActiveExplorer.CurrentFolder.Items

如果您只希望导出所选联系人的照片和信息，那么您可以使用以下几行：

Dim objSelection as Selection
Set objSelection = Outlook.Application.ActiveExplorer.Selection
For each objContact in objSelection

之后，您可以关闭 VBA 编辑器并像往常一样继续将新项目添加到快速访问工具栏。
最后，您可以单击快速访问工具栏中的宏按钮。联系人照片和信息将立即导出到本地磁盘的指定文件夹中。

您可以打开一个文本文件，其中将列出主要信息，如下图所示：

处理意外的 Outlook 损坏

毫无疑问，Outlook 易受攻击。因此，如果您遭受 Outlook 损坏，您首先应该做的是冷静下来。然后就可以继续修复了损坏的 Outlook PST 电子邮件. 您可以使用收件箱修复工具试一试。如果失败，那么您别无选择，只能使用更强大的工具，例如 DataNumen Outlook Repair.

作者简介：

Shirley Zhang 是一位数据恢复专家 DataNumen, Inc.，它是数据恢复技术领域的世界领先者，包括修复损坏的 SQL mdf 数据库和 outlook 修复软件产品。欲了解更多信息，请访问 datanumen.com