Economizando anexos do email atual em uma pasta derivada.

Question

Estou procurando um ponto de partida aqui, então não há código para postar, tenho medo!

Eu gostaria (se possível) poder abrir um email no Outlook (da maneira normal, do front-end) e clique em um botão para executar uma macro, que extrairá os anexos deste email e salve-os a um caminho de diretório (derivado do sujeito).

Som possível?

Quaisquer indicadores, links de snippets de código são bem -vindos!

Answer 1

Ok, cheguei a economizar na pasta local e excluir da mensagem. Ainda não resolvi botões, mas tenho certeza de que não é a coisa mais difícil do mundo ...

Então, eu iria verificar a documentação do VBA sobre Métodos de anexo, especificamente o que SaveAsFile, pois tem um exemplo completo que eu costumava testar as coisas. Os dois métodos disponíveis são exatamente os que você precisa:

SaveAsFile

e

Delete

Mas como o VBA não faz nada simples, o uso dessas duas linhas exige 15 outras.

Também há um ótimo site chamado OutlookCode.com. O administrador do site é um assistente VBA/Outlook e ela responderá pessoalmente às suas perguntas se elas ficarem nos fóruns por mais de um dia (não uma garantia, apenas minha experiência). O site está cheio de fontes e código de outras pessoas, etc.

Aqui está o que escrevi para experimentar o que você tinha em mente, com base na amostra do MSDN, que eu adicionei o método de exclusão, tornando -o um clique de salvar/excluir:

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

Esteja ciente de que a amostra original possui uma caixa de diálogo para perguntar ao usuário se eles têm certeza de que desejam salvar, pois substituirá quaisquer arquivos com o mesmo nome. Eu o excluí para simplificar um pouco o código.

Answer 2

Esta sub -rotina salvará todos os anexos encontrados em uma pasta do Outlook especificada pelo usuário em um diretório especificado pelo usuário no sistema de arquivos. Ele também atualiza cada mensagem com um link para os arquivos purgados.

Ele contém comentários extras para ajudar a destacar como o método .Delete diminuirá dinamicamente os contêineres de fixação (pesquise "~~ nos comentários).

Esta sub -rotina é testada apenas no 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