从 Outlook 联系人中提取附件

Question

我想知道是否有人设法构建代码来提取 Outlook 联系人中的附件？我的 Outlook 2010 中有很多联系人，有几个附件，我想创建一个备份副本。另外，如果存在自动方式，是否可以将下载的附件链接到联系人？

更新 我已经使用了几段代码来做我想做的事情，但是得到了一个“未定义的用户定义类型”。有谁知道如何避免这个错误？

    Option Explicit
Sub GetAttachments()
    Dim ns As Outlook.NameSpace
    Dim contactFolder As Outlook.MAPIFolder
    Dim myItem As Outlook.Item
    Dim ContactItem As Object
    Dim Attmt As Outlook.Attachments
    Dim FileName As String
    Dim i As Integer
    Set ns = Application.GetNamespace("MAPI")
    Set contactFolder = ns.GetDefaultFolder(olFolderContacts)
    Set myItem = contactFolder.Items
    Set Attmt = myItem.Attachments
    i = 0
' Check each contacts for attachments
    For Each ContactItem In contactFolder.Items
' Save any attachments found
        For Each Attmt In ContactItem.Attachments
        ' This path must exist! Change folder name as necessary.
            FileName = "C:\Temp\" & Attmt.FileName
            Attmt.SaveAsFile FileName
            i = i + 1
         Next Attmt
    Next ContactItem
End Sub

Answer 1

使用 ContactItem.Attachments 集合。要保存附件，请调用 Attachment.SaveAsFile。

Answer 2

您可以开发 VBA 宏或插件来完成工作。请注意，VBA 宏不是为在多台 PC 上分发解决方案而设计的。有关 Outlook 中 VBA 宏的详细信息，请参阅 Getting Started with VBA in Outlook 2010。

如果您需要从其他应用程序自动化 Outlook，请参阅 How to automate Outlook by using Visual Basic。

按照 Dmitry 的建议，您可以使用 Attachment 类的 SaveAsFile 方法将附件保存在磁盘上。

Sub SaveAttachment() 
 Dim myInspector As Outlook.Inspector 
 Dim myItem As Outlook.ContactItem 
 Dim myAttachments As Outlook.Attachments 
 Set myInspector = Application.ActiveInspector 
 If Not TypeName(myInspector) = "Nothing" Then 
   If TypeName(myInspector.CurrentItem) = "ContactItem" Then 
     Set myItem = myInspector.CurrentItem 
     Set myAttachments = myItem.Attachments 
     'Prompt the user for confirmation 
     Dim strPrompt As String 
     strPrompt = "Are you sure you want to save the first attachment in the current item to the Documents folder? If a file with the same name already exists in the destination folder, it will be overwritten with this copy of the file." 
     If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then 
       myAttachments.Item(1).SaveAsFile Environ("HOMEPATH") & "\My Documents\" & _ 
       myAttachments.Item(1).DisplayName 
     End If 
   Else 
     MsgBox "The item is of the wrong type." 
   End If
 End If
End Sub

要重新附加文件，您可以使用 Attachments 类的 Add 方法，该方法会在 Attachments 集合中创建一个新附件。

Sub AddAttachment() 
 Dim myItem As Outlook.MailItem 
 Dim myAttachments As Outlook.Attachments 

 Set myItem = Application.CreateItem(olMailItem) 
 Set myAttachments = myItem.Attachments 
 myAttachments.Add "C:\Test.doc", _ 
 olByValue, 1, "Test" 
 myItem.Display 
End Sub