将当前电子邮件中的附件保存到派生文件夹。

Question

我正在这里寻找一个起点，所以恐怕没有代码可以发布！

我希望（如果可能）能够在 Outlook 中打开一封电子邮件（以正常方式，从前端），然后单击一个按钮以运行一个宏，该宏将从该电子邮件中提取附件并将它们保存到目录路径（源自主题）。

听起来可行吗？

任何指针，链接代码sn-ps欢迎！

Answer 1

好的，我已经保存到本地文件夹并从消息中删除了。我还没有设计出按钮，但我敢肯定这不是世界上最难的事情......

所以我会查看 Attachment Methods 上的 VBA 文档，特别是 SaveAsFile 上的文档，因为它有一个完整的示例，我用来测试它。可用的两种方法正是您需要的方法：

SaveAsFile

和

Delete

但由于 VBA 并不简单，使用这两行需要另外 15 行。

还有一个非常棒的网站，叫做outlookcode.com。站点管理员是 VBA/Outlook 向导，如果他们在论坛上停留超过一天，她会亲自回答您的问题（不是保证，只是我的经验）。该站点充满了源代码和其他人的代码等。

这是我写的，以尝试您的想法，基于 MSDN 的示例，我添加了删除方法，使其成为一键保存/删除：

Sub getAttatchment()
    Dim myInspector As Outlook.Inspector
    Dim myItem As Outlook.MailItem
    Dim myAttachments As Outlook.Attachments

    Set myInspector = Application.ActiveInspector
    If Not TypeName(myInspector) = "Nothing" Then
        If TypeName(myInspector.CurrentItem) = "MailItem" Then
            Set myItem = myInspector.CurrentItem
            Set myAttachments = myItem.Attachments
            If myAttachments.Item(1).DisplayName = "" Then
                Set myAttachments.Item(1).DisplayName = myAttachments.Item(1).FileName
            End If
                myAttachments.Item(1).SaveAsFile Environ("HOMEPATH") _ 
                & "\My Documents\" & myAttachments.Item(1).DisplayName
                myAttachments.Item(1).Delete
        Else
            MsgBox "The item is of the wrong type."
        End If
    End If
End Sub

请注意，原始示例有一个对话框询问用户是否确定要保存，因为它会覆盖任何同名文件。我删除了它以简化代码。

Answer 2

此子例程会将在用户指定的 Outlook 文件夹中找到的所有附件保存到文件系统上用户指定的目录中。它还使用指向已清除文件的链接更新每条消息。

它包含额外的 cmets，以帮助突出显示 .Delete 方法如何动态收缩附件容器（在 cmets 中搜索“~~”）。

此子例程仅在 Outlook 2010 上测试。

' ------------------------------------------------------------.
' Requires the following references:
'    Visual Basic for Applications
'    Microsoft Outlook 14.0 Object Library
'    OLE Automation
'    Microsoft Office 14.0 Object Library
'    Microsoft Shell Controls and Automation
' ------------------------------------------------------------.

Public Sub SaveOLFolderAttachments()

 ' Ask the user to select a file system folder for saving the attachments
 Dim oShell As Object
 Set oShell = CreateObject("Shell.Application")
 Dim fsSaveFolder As Object
 Set fsSaveFolder = oShell.BrowseForFolder(0, "Please Select a Save Folder:", 1)
 If fsSaveFolder Is Nothing Then Exit Sub
 ' Note:  BrowseForFolder doesn't add a trailing slash

 ' Ask the user to select an Outlook folder to process
 Dim olPurgeFolder As Outlook.MAPIFolder
 Set olPurgeFolder = Outlook.GetNamespace("MAPI").PickFolder
 If olPurgeFolder Is Nothing Then Exit Sub

 ' Iteration variables
 Dim msg As Outlook.MailItem
 Dim att As Outlook.attachment
 Dim sSavePathFS As String
 Dim sDelAtts as String

 For Each msg In olPurgeFolder.Items

   sDelAtts = ""

   ' We check each msg for attachments as opposed to using .Restrict("[Attachment] > 0")
   ' on our olPurgeFolder.Items collection.  The collection returned by the Restrict method
   ' will be dynamically updated each time we remove an attachment.  Each update will
   ' reindex the collection.  As a result, it does not provide a reliable means for iteration.
   ' This is why the For Each style loops will not work. ~~
   If msg.Attachments.Count > 0 Then

     ' This While loop is controlled via the .Delete method which
     ' will decrement msg.Attachments.Count by one each time. ~~
     While msg.Attachments.Count > 0

       ' Save the attachment to the file system
       sSavePathFS = fsSaveFolder.Self.Path & "\" & msg.Attachments(1).FileName
       msg.Attachments(1).SaveAsFile sSavePathFS

       ' Build up a string to denote the file system save path(s)
       ' Format the string according to the msg.BodyFormat.
       If msg.BodyFormat <> olFormatHTML Then
            sDelAtts = sDelAtts & vbCrLf & "<file://" & sSavePathFS & ">"
       Else
            sDelAtts = sDelAtts & "<br>" & "<a href='file://" & sSavePathFS & "'>" & sSavePathFS & "</a>"
       End If

       ' Delete the current attachment.  We use a "1" here instead of an "i"
       ' because the .Delete method will shrink the size of the msg.Attachments
       ' collection for us.  Use some well placed Debug.Print statements to see
       ' the behavior. ~~
       msg.Attachments(1).Delete

      Wend

     ' Modify the body of the msg to show the file system location of
     ' the deleted attachments.
     If msg.BodyFormat <> olFormatHTML Then
        msg.Body = msg.Body & vbCrLf & vbCrLf & "Attachments Deleted:  " & Date & " " & Time & vbCrLf & vbCrLf & "Saved To:  " & vbCrLf & sDelAtts
     Else
        msg.HTMLBody = msg.HTMLBody & "<p></p><p>" & "Attachments Deleted:  " & Date & " " & Time & vbCrLf & vbCrLf & "Saved To:  " & vbCrLf & sDelAtts & "</p>"
     End If

      ' Save the edits to the msg.  If you forget this line, the attachments will not be deleted.  ~~
     msg.Save

    End If

  Next

End Sub