從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。

正如德米特里所建議的，您可以使用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 

要附加文件重新可以使用它創建的附件收集新的附件附件類的Add方法。

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