Какой самый быстрый способ хранения вложений в почтовом ящике Outlook?

Question

Предположим, у меня настроен почтовый ящик, и у меня есть специальная папка для писем с вложениями в outlook 2007. Что я хочу сделать, так это i.либо настройте outlook, чтобы сохранить вложение писем, поступающих в указанной папке (Почта с вложениями), в определенную папку на диске моего компьютера в нужной папке

ii.Или если я могу написать какой-нибудь макрос или скрипт, чтобы скопировать все это на мой компьютер.Если да, можете ли вы дать мне краткий обзор или направить меня куда-нибудь.

Answer 1

Эта подпрограмма сохраняет все вложения, найденные в указанной пользователем папке 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

Answer 2

Код ниже автоматически сохранит вложения в каталог. Используйте правила 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