Сохранение вложений из текущего электронного письма в производную папку.

Question

Я ищу здесь отправную точку, поэтому я не боюсь писать код!

Я хотел бы (если это возможно), чтобы иметь возможность открыть электронное письмо в Outlook (обычным способом из внешнего интерфейса), а затем нажать кнопку для запуска макроса, который извлечет вложения из этого электронного письма. и сохраните их в путь к каталогу (полученный из темы).

Звук можно сделать?

Любые указатели, фрагменты кода ссылок приветствуются!

Answer 1

Хорошо, я дошел до сохранения в локальную папку и удаления из сообщения. Я еще не разработал кнопки, но я уверен, что это не самая сложная вещь в мире ...

Итак, я бы ознакомился с документацией 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