Salvataggio degli allegati dalle e-mail corrente in una cartella derivata.

Question

Sto cercando un punto di partenza qui, quindi nessun codice di inviare ho paura!

Vorrei (se possibile) per essere in grado di aprire una e-mail in Outlook (in modo normale, dal front-end), e quindi fare clic su un pulsante per eseguire una macro, che estrarre gli allegati da questa e-mail e salvarli in un percorso di directory (derivato dal soggetto).

Audio fattibile?

Tutti gli indicatori, collegamenti frammenti di codice benvenuti!

Answer 1

Va bene, ho ottenuto per quanto riguarda il risparmio di cartella locale e l'eliminazione dal messaggio. Non ho ancora elaborato i pulsanti, ma sono sicuro che non è la cosa più difficile del mondo ...

Quindi mi sento di controllare la documentazione VBA su metodi di fissaggio , in particolare quello sul SaveAsFile, in quanto ha un esempio completo che ho usato per collaudare il tutto. I due metodi disponibili sono quelli esatti avete bisogno:

SaveAsFile

e

Delete

Ma poiché VBA fa nulla semplice, con quelle due righe richiede altri 15.

Inoltre v'è davvero un ottimo sito chiamato outlookcode.com . L'amministratore del sito è una procedura guidata VBA / Outlook e lei personalmente rispondere alle vostre domande, se si siedono sul forum per un più di un giorno (non una garanzia, solo la mia esperienza). Il sito è ricco di sorgenti e altro codice della gente, ecc.

Ecco quello che ho scritto per provare quello che aveva in mente, sulla base del campione da MSDN, che ho aggiunto il metodo delete, rendendolo un un clic Save / delete:

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

Essere consapevoli del fatto che il campione originale ha una finestra di dialogo per chiedere all'utente se sono sicuro che vogliono salvare in quanto sovrascrive tutti i file con lo stesso nome. Ho cancellato per semplificare il codice un po '.

Answer 2

Questa subroutine salverà tutti gli allegati si trovano in una cartella di Outlook utente specificato in una directory specificata utente sul file system. Si aggiorna anche ogni messaggio con un link per i file eliminati.

E 'contiene commenti in più per contribuire a evidenziare come il metodo .Delete si ridurrà contenitori di fissaggio in modo dinamico (cercare "~~" nei commenti).

Questa subroutine è stato testato solo su 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