Сохранение вложений из текущей электронной почты в производную папку.

Question

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

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

Звук в состоянии?

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

Answer 1

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

Так что я бы посмотрел документацию VBA по адресу Attachment Methods, в частности, на SaveAsFile, так как он имеет полный пример, который я использовал для проверки. Эти два метода являются точными из них вам нужно:

SaveAsFile 

и

Delete 

Но поскольку VBA не делают ничего простого, с помощью этих двух линий требуют 15 других.

Также есть ДЕЙСТВИТЕЛЬНО отличный сайт под названием outlookcode.com. Администратор сайта - мастер VBA/Outlook, и она лично ответит на ваши вопросы, если они будут сидеть на форумах более одного дня (не гарантия, только мой опыт). На сайте полно источников и кода других людей.

Вот что я написал, чтобы опробовать то, что вы имели в виду, на основе образца из MSDN, в котором я добавил метод удаления, сделав его одним нажатием кнопки save/удаления:

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