Question

假设我配置了我的邮箱，并且我在Outlook 2007中有一个带附件的邮件的特殊文件夹。我想要做的是一世。配置Outlook以保存指定文件夹中的邮件附件（带附件的邮件）到我所需文件夹中的计算机驱动器中的特定文件夹

II。或者，如果我可以编写一些宏或脚本将所有宏或脚本复制到我的计算机位置。如果是这样，请你快速给我一些概述，或者在某处找我。

Answer 1

以下代码会自动将附件保存到目录中。使用Outlook规则自动在每个传入邮件上运行此宏。

Sub AutoSaveAttachment(Item As Outlook.MailItem)
    Dim olAtt As Attachment
    Dim i As Integer
    Dim FIleNamewithDate As String
    Const FILE_PATH As String = "C:\"

    If Item.Attachments.Count > 0 Then
        For i = 1 To Item.Attachments.Count
            Set olAtt = Item.Attachments(i)
            olAtt.SaveAsFile FILE_PATH & olAtt.FileName


        Next i
    End If

    Set olAtt = Nothing

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 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 file
        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

在Outlook邮箱邮件中存储附件的最快方法是什么？

2 个答案: