Como guardar todos os anexos de vários e-mails numa única pasta no Outlook?

É fácil guardar todos os anexos de um único e-mail com a funcionalidade integrada **Guardar Todos os Anexos** no Outlook. No entanto, se pretender guardar todos os anexos de vários e-mails de uma só vez, o Outlook não oferece uma opção direta para o fazer. Terá de aplicar repetidamente a funcionalidade **Guardar Todos os Anexos** a cada mensagem até que todos os ficheiros estejam guardados — um processo moroso e pouco eficiente. Neste artigo, apresentamos-lhe dois métodos práticos para guardar em lote todos os anexos de vários e-mails diretamente numa pasta específica do seu computador, poupando tempo e esforço.

Guardar todos os anexos de vários e-mails numa pasta com código VBA
Alguns cliques para guardar todos os anexos de vários e-mails numa pasta com uma ferramenta extraordinária

Guardar todos os anexos de vários e-mails numa pasta com código VBA

Esta secção apresenta um código VBA, explicado passo a passo, para o ajudar a guardar rapidamente todos os anexos de vários e-mails numa pasta específica de uma só vez. Siga estes passos:

1. Em primeiro lugar, terá de criar uma pasta no seu computador para guardar os anexos.

Aceda à pasta «Documentos» e crie uma nova pasta com o nome «Anexos». Consulte a imagem:

2. Selecione os e-mails cujos anexos deseja guardar e, em seguida, prima as teclas «Alt» + «F11» para abrir a janela «Microsoft Visual Basic para Aplicações».

3. Clique em «Inserir» > «Módulo» para abrir a janela «Módulo» e, de seguida, copie um dos seguintes códigos VBA para essa janela.

Código VBA 1: Guardar em lote anexos de vários e-mails (guardar diretamente anexos com exatamente o mesmo nome)

Dica: Este código guardará anexos com exatamente o mesmo nome, adicionando os dígitos 1, 2, 3... após o nome do ficheiro.

Dim GCount As Integer
Dim GFilepath As String
Public Sub SaveAttachments()
'Update 20200821
Dim xMailItem As Outlook.MailItem
Dim xAttachments As Outlook.Attachments
Dim xSelection As Outlook.Selection
Dim i As Long
Dim xAttCount As Long
Dim xFilePath As String, xFolderPath As String, xSaveFiles As String
On Error Resume Next
xFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
Set xSelection = Outlook.Application.ActiveExplorer.Selection
xFolderPath = xFolderPath & "\Attachments\"
If VBA.Dir(xFolderPath, vbDirectory) = vbNullString Then
    VBA.MkDir xFolderPath
End If
GFilepath = ""
For Each xMailItem In xSelection
    Set xAttachments = xMailItem.Attachments
    xAttCount = xAttachments.Count
    xSaveFiles = ""
    If xAttCount > 0 Then
        For i = xAttCount To 1 Step -1
            GCount = 0
            xFilePath = xFolderPath & xAttachments.Item(i).FileName
            GFilepath = xFilePath
            xFilePath = FileRename(xFilePath)
            If IsEmbeddedAttachment(xAttachments.Item(i)) = False Then
                xAttachments.Item(i).SaveAsFile xFilePath
                If xMailItem.BodyFormat <> olFormatHTML Then
                    xSaveFiles = xSaveFiles & vbCrLf & "<Error! Hyperlink reference not valid.>"
                Else
                    xSaveFiles = xSaveFiles & "<br>" & "<a href='file://" & xFilePath & "'>" & xFilePath & "</a>"
                End If
            End If
        Next i
    End If
Next
Set xAttachments = Nothing
Set xMailItem = Nothing
Set xSelection = Nothing
End Sub

Function FileRename(FilePath As String) As String
Dim xPath As String
Dim xFso As FileSystemObject
On Error Resume Next
Set xFso = CreateObject("Scripting.FileSystemObject")
xPath = FilePath
FileRename = xPath
If xFso.FileExists(xPath) Then
    GCount = GCount + 1
    xPath = xFso.GetParentFolderName(GFilepath) & "\" & xFso.GetBaseName(GFilepath) & " " & GCount & "." + xFso.GetExtensionName(GFilepath)
    FileRename = FileRename(xPath)
End If
xFso = Nothing
End Function

Function IsEmbeddedAttachment(Attach As Attachment)
Dim xItem As MailItem
Dim xCid As String
Dim xID As String
Dim xHtml As String
On Error Resume Next
IsEmbeddedAttachment = False
Set xItem = Attach.Parent
If xItem.BodyFormat <> olFormatHTML Then Exit Function
xCid = ""
xCid = Attach.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001F")
If xCid <> "" Then
    xHtml = xItem.HTMLBody
    xID = "cid:" & xCid
    If InStr(xHtml, xID) > 0 Then
        IsEmbeddedAttachment = True
    End If
End If
End Function

Código VBA 2: Guardar em lote anexos de vários e-mails (verificar duplicados)

Public Sub SaveAttachments()
'Update 20200821
Dim xMailItem As Outlook.MailItem
Dim xAttachments As Outlook.Attachments
Dim xSelection As Outlook.Selection
Dim i As Long
Dim xAttCount As Long
Dim xFilePath As String, xFolderPath As String, xSaveFiles As String
Dim xYesNo As Integer
Dim xFlag As Boolean
On Error Resume Next
xFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
Set xSelection = Outlook.Application.ActiveExplorer.Selection
xFolderPath = xFolderPath & "\Attachments\"
If VBA.Dir(xFolderPath, vbDirectory) = vbNullString Then
    VBA.MkDir xFolderPath
End If
For Each xMailItem In xSelection
    Set xAttachments = xMailItem.Attachments
    xAttCount = xAttachments.Count
    xSaveFiles = ""
    If xAttCount > 0 Then
        For i = xAttCount To 1 Step -1
            xFilePath = xFolderPath & xAttachments.Item(i).FileName
            xFlag = True
            If VBA.Dir(xFilePath, 16) <> Empty Then
                xYesNo = MsgBox("The file is exists, do you want to replace it", vbYesNo + vbInformation, "Kutools for Outlook")
                If xYesNo = vbNo Then xFlag = False
            End If
            If xFlag = True Then
                xAttachments.Item(i).SaveAsFile xFilePath
                If xMailItem.BodyFormat <> olFormatHTML Then
                    xSaveFiles = xSaveFiles & vbCrLf & "<Error! Hyperlink reference not valid.>"
                Else
                    xSaveFiles = xSaveFiles & "<br>" & "<a href='file://" & xFilePath & "'>" & xFilePath & "</a>"
                End If
            End If
        Next i
    End If
Next
Set xAttachments = Nothing
Set xMailItem = Nothing
Set xSelection = Nothing
End Sub

Notas:

1) Se pretender guardar todos os anexos com o mesmo nome numa pasta, utilize o «Código VBA 1» acima indicado. Antes de executar este código, clique em «Ferramentas» > «Referências» e ative a caixa «Microsoft Scripting Runtime» na caixa de diálogo «Referências - Projeto».

2) Se pretender verificar duplicados Nome do Anexo, utilize o «Código VBA 2». Após executar o código, surgirá uma caixa de diálogo a perguntar se pretende substituir o Anexos duplicados; escolha «Sim» ou «Não» consoante as suas necessidades.

5. Prima a tecla «F5» para executar o código.

Em seguida, todos os anexos dos e-mails selecionados são guardados na pasta que criou no passo 1.

Notas: Poderá aparecer uma caixa de aviso do «Microsoft Outlook». Clique no botão «Permitir» para continuar.

Guardar todos os anexos de vários e-mails numa pasta com uma ferramenta extraordinária

Se é novo na utilização de VBA, recomendamos vivamente a funcionalidade «Guardar Todos os Anexos» do «Kutools para Outlook». Com ela, pode guardar rapidamente todos os anexos de vários e-mails de uma só vez, com apenas alguns cliques no Outlook.

1. Selecione os e-mails que contêm os anexos que deseja guardar.

Dicas: Pode selecionar vários e-mails não adjacentes mantendo premida a tecla «Ctrl» e selecionando-os um a um;
ou selecionar vários e-mails adjacentes mantendo premida a tecla «Shift» e clicando no primeiro e no último.

2. Clique em «KUTOOLS PLUS» > «Ferramentas de Anexo» > «Guardar Tudo». Veja a imagem:

3. Na caixa de diálogo «Configurações de salvamento», clique no botão para selecionar uma pasta onde pretende guardar os anexos e, em seguida, clique no botão «OK».

4. Clique em «OK» duas vezes nas próximas caixas de diálogo que surgirem — assim, todos os anexos dos e-mails selecionados serão guardados imediatamente na pasta especificada.

Notas:

• 1. Se pretender guardar anexos em pastas diferentes com base nos e-mails, active a caixa de verificação «Criar subpastas no seguinte estilo» e selecione um estilo de pasta no menu pendente.
• 2. Além de guardar todos os anexos, pode guardá-los com base em condições específicas. Por exemplo, se pretender guardar apenas os anexos em formato PDF cujo nome do ficheiro contenha a palavra «Invoice», clique no botão «Opções avançadas» para expandir as condições e configure-as conforme indicado abaixo.
  
• 3. Se pretender guardar automaticamente os anexos à medida que os e-mails chegam, a funcionalidade Salvar Anexos Automaticamente pode ajudar.
• 4. Para desanexar diretamente os ficheiros dos e-mails selecionados, a funcionalidade Desanexar todos os anexos do «Kutools para Outlook» pode ser-lhe útil.

Artigos relacionados

---

Melhores Ferramentas de Produtividade para o Office

Experimente o totalmente novo Kutools para Outlook com 100+ funcionalidades incríveis!Clique para transferir já!

🤖KUTOOLS AI:Utiliza tecnologia avançada de IA para gerir e-mails sem esforço, incluindo responder, resumir, otimizar, alongar, traduzir e redigir mensagens.

📧Automação de E-mails: Resposta Automática (disponível para POP e IMAP) / Agendar Envio de E-mails / CC/BCC Automático por Regras ao Enviar E-mail / Encaminhamento Automático (regra avançada) / Adicionar Saudação Automaticamente / Dividir Automaticamente E-mails com Múltiplos Destinatários em Mensagens Individuais...

📨Gestão de E-mails: Recallar e-mail / Bloquear e-mails fraudulentos por assunto e outros critérios / Eliminar e-mails duplicados / Pesquisa avançada / Organizar pastas...

📁Anexos Pro: Guardar em Lote / Desanexar em Lote / Comprimir em Lote / Salvar Automaticamente / Desanexar Automaticamente / Auto Comprimir...

🌟Magia da Interface: 😊 Mais Emojis Bonitos e Divertidos / Avisa-o quando chegam e-mails importantes / Minimizar o Outlook em vez de fechá-lo...

👍Maravilhas com um Clique: Responder a Todos com Anexos / E-mails Anti-Phishing / 🕘 Mostrar Fuso Horário – Hora Atual do Remetente...

👩🏼‍🤝‍👩🏻Contactos e Calendário: Criar contactos em lote a partir de e-mails selecionados / Dividir um grupo de contactos em grupos individuais / Remover lembrete de aniversário...

Utilize o Kutools no seu idioma preferido – com suporte para inglês, espanhol, alemão, francês, chinês e mais de 40 idiomas!

Desbloqueie instantaneamente o Kutools para Outlook com um único clique! Não espere mais — transfira já e aumente a sua eficiência!

Lista de Funcionalidades do Kutools para Outlook      Transferir Já      Ir para Compra

🚀 Transferência com um Clique — Obtenha Todos os Extras do Office

Altamente Recomendado: Kutools for Office (5 em 1)

Um clique para transferir cinco instaladoresde uma só vez —Kutools para Excel, Outlook, Word, PowerPointe Office Tab Pro.Clique para transferir já!

• ✅Conveniência com um clique: Transfira os cinco pacotes de instalação numa única ação.
• 🚀Pronto para qualquer tarefa no Office: instale os extras que precisa, exatamente quando os precisar.
• 🧰Incluídos: Kutools para Excel / Kutools para Outlook / Kutools para Word / Office Tab Pro / Kutools for PowerPoint

Sobre o Conjunto⬇ Transferir o Conjunto💳 Comprar o Conjunto