Question

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

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

声音可以吗？

任何指针，链接代码片段欢迎！

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文件夹中找到的所有附件保存到文件系统上的用户指定目录。它还会使用指向已清除文件的链接更新每条消息。

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

此子例程仅在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

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

2 个答案: