Note: The other languages of the website are Google-translated. Back to English

Como salvar todos os anexos de vários e-mails em uma pasta no Outlook?

É fácil salvar todos os anexos de um e-mail com o recurso embutido Salvar todos os anexos no Outlook. No entanto, se você deseja salvar todos os anexos de vários e-mails de uma vez, nenhum recurso direto pode ajudar. Você precisa aplicar repetidamente o recurso Salvar todos os anexos em cada e-mail até que todos os anexos sejam salvos desses e-mails. Isso é demorado. Neste artigo, apresentamos dois métodos para você salvar em massa todos os anexos de vários e-mails em uma pasta específica facilmente no Outlook.

Salve todos os anexos de vários e-mails em uma pasta com o código VBA
Vários cliques para salvar todos os anexos de vários e-mails em uma pasta com uma ferramenta incrível


Salve todos os anexos de vários e-mails em uma pasta com o código VBA

Esta seção demonstra um código VBA em um guia passo a passo para ajudá-lo a salvar rapidamente todos os anexos de vários emails em uma pasta específica de uma vez. Faça o seguinte.

1. Em primeiro lugar, você precisa criar uma pasta para salvar os anexos em seu computador.

Entre no Documentos pasta e crie uma pasta chamada “Anexos”. Veja a imagem:

2. Selecione os e-mails cujos anexos você salvará e pressione outro + F11 chaves para abrir o Microsoft Visual Basic para Aplicações janela.

3. Clique inserção > Módulo para abrir o Módulo janela e, em seguida, copie um dos seguintes códigos VBA para a janela.

Código VBA 1: salvar em massa anexos de vários e-mails (salvar diretamente anexos com o mesmo nome)

Tips: Este código salvará exatamente os mesmos anexos de nome adicionando os dígitos 1, 2, 3 ... após os nomes dos arquivos.

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: salvar em massa anexos de vários e-mails (verifique se há duplicatas)
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 você deseja salvar todos os anexos com o mesmo nome em uma pasta, aplique o acima Código VBA 1. Antes de executar este código, clique em Ferramentas > Referências, e depois verifique o Tempo de execução de scripts da Microsoft caixa no Referências - Projeto caixa de diálogo;

doc salvar anexos 07

2) Se você deseja verificar se há nomes de anexo duplicados, aplique o código VBA 2. Depois de executar o código, uma caixa de diálogo aparecerá para lembrá-lo se deseja substituir os anexos duplicados, escolha Sim or Não com base em suas necessidades.

5. aperte o F5 chave para executar o código.

Em seguida, todos os anexos em e-mails selecionados são salvos na pasta que você criou na etapa 1. 

notas: Pode haver um Microsoft Outlook caixa de prompt aparecendo, por favor, clique no Permitir botão para ir em frente.


Salve todos os anexos de vários e-mails em uma pasta com uma ferramenta incrível

Se você é um novato no VBA, aqui recomendo fortemente o Salvar todos os anexos utilidade de Kutools para Outook para voce. Com este utilitário, você pode salvar rapidamente todos os anexos de vários e-mails de uma vez com vários cliques apenas no Outlook.
Antes de aplicar o recurso, por favor baixe e instale o Kutools para Outlook primeiro.

1. Selecione os e-mails contendo os anexos que você deseja salvar.

Dicas: Você pode selecionar vários e-mails não adjacentes segurando o Ctrl tecla e selecione-os um por um;
Ou selecione vários e-mails adjacentes segurando o mudança e selecione o primeiro e-mail e o último.

2. Clique Kutools >Ferramentas de AnexoSalve Todos. Veja a imagem:

3. No Salvar configurações diálogo, clique no para selecionar uma pasta para salvar os anexos e, em seguida, clique no OK botão.

3. Clique OK duas vezes na próxima janela pop-up, então todos os anexos dos e-mails selecionados são salvos na pasta especificada de uma vez.

notas:

  • 1. Se você deseja salvar anexos em pastas diferentes com base em e-mails, verifique o Crie subpastas no seguinte estilo e escolha um estilo de pasta no menu suspenso.
  • 2. Além de salvar todos os anexos, você pode salvar anexos por condições específicas. Por exemplo, se você deseja salvar apenas os anexos do arquivo pdf cujo nome do arquivo contém a palavra "Fatura", clique no botão opções avançadas para expandir as condições e, em seguida, configurar conforme mostrado a seguir.
  • 3. Se você deseja salvar automaticamente os anexos quando o e-mail chegar, o Salvar anexos automaticamente recurso pode ajudar.
  • 4. Para desanexar os anexos diretamente dos e-mails selecionados, o Desanexar todos os anexos característica de Kutools para Outlook pode te fazer um favor.

  Se você quiser ter um teste gratuito (60 dias) deste utilitário, por favor clique para fazer o downloade, em seguida, aplique a operação de acordo com as etapas acima.


Artigos relacionados

Insira anexos no corpo da mensagem de e-mail no Outlook
Normalmente, os anexos são exibidos no campo Anexado em um e-mail de redação. Aqui, este tutorial fornece métodos para ajudá-lo a inserir facilmente anexos no corpo do e-mail no Outlook.

Baixar / salvar automaticamente anexos do Outlook para uma determinada pasta
De um modo geral, você pode salvar todos os anexos de um e-mail clicando em Anexos> Salvar todos os anexos no Outlook. Mas, se precisar salvar todos os anexos de todos os emails recebidos e recebidos, algum ideal? Este artigo apresentará duas soluções para baixar automaticamente anexos do Outlook para uma determinada pasta.

Imprima todos os anexos em um / vários e-mails no Outlook
Como você sabe, ele só imprimirá o conteúdo do e-mail, como cabeçalho e corpo, quando você clicar em Arquivo> Imprimir no Microsoft Outlook, mas não imprimirá os anexos. Aqui vamos mostrar como imprimir todos os anexos em um e-mail selecionado com facilidade no Microsoft Outlook.

Pesquisar palavras em anexo (conteúdo) no Outlook
Quando digitamos uma palavra-chave na caixa de Pesquisa Instantânea do Outlook, ele vai pesquisar a palavra-chave nos assuntos, corpos, anexos, etc. dos emails. Mas agora só preciso pesquisar a palavra-chave no conteúdo dos anexos apenas no Outlook, alguma ideia? Este artigo mostra as etapas detalhadas para pesquisar palavras no conteúdo de anexos no Outlook com facilidade.

Mantenha os anexos ao responder no Outlook
Quando encaminhamos uma mensagem de e-mail no Microsoft Outlook, os anexos originais dessa mensagem de e-mail permanecem na mensagem encaminhada. No entanto, quando respondemos a uma mensagem de e-mail, os anexos originais não serão anexados na nova mensagem de resposta. Aqui, vamos apresentar alguns truques sobre como manter os anexos originais ao responder no Microsoft Outlook.


Kutools for Outlook - traz 100 recursos avançados para o Outlook e torna o trabalho muito mais fácil!

  • Auto CC / BCC por regras ao enviar e-mail; Avanço automático Vários emails por encomenda; Resposta automatica sem servidor Exchange e mais recursos automáticos ...
  • Aviso BCC - mostrar mensagem quando você tentar responder a todos se o seu endereço de e-mail estiver na lista BCC; Lembrar quando houver anexos ausentes, e mais recursos de lembrete ...
  • Responder (todos) com todos os anexos na conversa de correio; Responder muitos e-mails em segundos; Adicionar saudação automaticamente quando responder; Adicionar data ao assunto ...
  • Ferramentas de anexo: gerenciar todos os anexos em todos os e-mails, Desanexação Automática, Comprimir tudo, Renomear tudo, Salvar tudo ... Relatório rápido, Contar e-mails selecionados...
  • Lixo eletrônico poderoso por costume; Remover e-mails e contatos duplicados... Permite que você faça de maneira mais inteligente, rápida e melhor no Outlook.
tiro kutools aba kutools do outlook 1180x121
tiro kutools outlook kutools mais guia 1180x121
 
Comentários (76)
Avaliado 2.75 fora do 5 · classificações 2
Este comentário foi feito pelo moderador no site
Quando tento executar isso, recebo um erro de sintaxe em objMsg.Save() - espera =
Este comentário foi feito pelo moderador no site
Quando tento executar isso, recebo um erro de sintaxe em objMsg.Save() - espera =
Este comentário foi feito pelo moderador no site
Mesmo erro de sintaxe do problema em objMsg.Save() ...
Este comentário foi feito pelo moderador no site
Algumas correções: 1. objMsg.Save 'sem () 2. Objetos devem ser atribuídos com SET (por exemplo, SET objSelection = objOL.ActiveExplorer.Selection) 3. O Loop principal deve conter um DoEvents para evitar blankout pelo Outlook. 4. Ao processar muitos e-mails (mais de 100), o Outlook pode travar. Parece que há um vazamento de memória em algum lugar. Apenas meus 2 centavos. Além dos bugs (provavelmente devido ao Outlook 2013), isso é muito bom e funciona. Muito obrigado por compartilhar.
Este comentário foi feito pelo moderador no site
Obrigado por compartilhar. Concordo com Stephan em seus dois primeiros pontos, veja alguns esclarecimentos sobre seu ponto 3. Finalmente, adicionar um DoEvents no lugar certo deve permitir que você processe um grande número de emails (basta executar este código em 157 emails no Outlook 2013). Alguns pensamentos adicionais: 1) Isso funciona apenas se você usar a pasta Documentos. Para um caso mais geral: delete line 12 line 15 deve ler: strFolderpath = "C:\folder\otherfolder\" substituto C:\pasta\outrapasta\ com qualquer caminho que você tem. 2) Este código não excluirá os anexos, se você quiser apenas excluir o ' inicial da linha 25. 3) Se você tiver anexos grandes, provavelmente é uma boa ideia (como Stephan observou) colocar uma função DoEvents após a linha 24. 4) Pessoalmente, não quero modificar os e-mails de forma alguma (por exemplo, adicionando o caminho de salvamento do arquivo ao texto do e-mail), se você concordar comigo, poderá excluir a linha 26-39. 5) Se você pular meu passo 4, então você pode permitir que o programa modifique os e-mails marcando "Permitir acesso por x tempo", então você deve clicar em permitir apenas uma vez (cf. passo 6 acima no original).
Este comentário foi feito pelo moderador no site
"Pessoalmente, não quero modificar os e-mails de forma alguma (por exemplo, adicionando o caminho de salvamento do arquivo ao texto do e-mail), se você concordar comigo, poderá excluir a linha 26-39. 5)"



Como posso excluí-lo APÓS o fato. Idk como usar regex com VBA
Avaliado 0.5 fora do 5
Este comentário foi feito pelo moderador no site
Seguindo as sugestões acima, eu tinha diariamente gerado pelo sistema e-mails com 'report.txt' anexado e precisava anexar a data de envio ao nome do arquivo salvo para evitar substituições e distinguir arquivos. Feito os seguintes acréscimos nos locais apropriados: add- Dim strSent As String add- strSent = Format(objMsg.SentOn, "yymmdd") add- strFile = strSent & strFile Os arquivos salvos agora são 140822Report.txt, etc.
Este comentário foi feito pelo moderador no site
Oi.. Eu tentei de tudo aqui, mas continuo recebendo o bloco Compile Error se sem fim se. Fiz ajustes de acordo com as sugestões de Thomas. Aqui está o código .. o que estou perdendo? Qualquer ajuda é apreciada. Public Sub SaveAttachments() 'Update 20130828 Dim objOL As Outlook.Application Dim objMsg As Outlook.MailItem Dim objAttachments As Outlook.Attachments Dim objSelection As Outlook.Selection Dim i As Long Dim lngCount As Long Dim strFile As String Dim strFolderpath As String Dim strDeletedFiles As String objOL = CreateObject("Outlook.Application") objSelection = objOL.ActiveExplorer.Selection strFolderpath = "C:\folder\Attachments\" Para cada objMsg Em objSelection objAttachments = objMsg.Attachments lngCount = objAttachments.Count strDeletedFiles = "" If lngCount > 0 Then For i = lngCount To 1 Step -1 strFile = objAttachments.Item(i).FileName strFile = strFolderpath & strFile objAttachments.Item(i).SaveAsFile strFile DoEvents 'objAttachments.Item(i).Delete() Next ExitSub: objAttachments = Nada objMsg = Nada Set objSelection = objOL.ActiveExplorer.Selection objOL = Nada End Sub
Este comentário foi feito pelo moderador no site
Para sharon -- O site abaixo corrige seu problema. www_dot_outlook-tips_dot_net/code-samples/save-and-delete-attachments/ Ele NÃO tem o código do recurso timestamp que o TXgardner forneceu acima, então se você quiser isso, você tem que editar seu código.
Este comentário foi feito pelo moderador no site
Isso funcionou muito bem, exceto por um problema. Todos os anexos em meus e-mails têm o mesmo nome, então, quando eles são copiados, o script continua substituindo o mesmo arquivo pelo próximo anexo na fila. Existe alguma maneira de fazê-lo renomeá-los em vez de reescrevê-los? Obrigado!
Este comentário foi feito pelo moderador no site
Como remover o "Os arquivos foram salvos em" que é mostrado abaixo.....
Este comentário foi feito pelo moderador no site
Acabei de ajustar o código após "Next i" e funcionou bem:
Proximo eu
Se xSaveFiles <> "" Então
If xMailItem.BodyFormat <> olFormatHTML Then

Outro

Se acabar
Este comentário foi feito pelo moderador no site
Isso funcionou, obrigado por isso. Livrei-me das mensagens nos e-mails.
Avaliado 5 fora do 5
Este comentário foi feito pelo moderador no site
Funciona muito bem sem problemas! Obrigado. Me economizou um monte de tempo! Obrigado, Josué
Este comentário foi feito pelo moderador no site
Obrigado! Isso me economizou muito tempo e frustração!
Este comentário foi feito pelo moderador no site
Eu posso fazer isso funcionar, mas como e o objSelection.Count é 2, mas ele só salvará os anexos no primeiro email.
Este comentário foi feito pelo moderador no site
É assim que o código está agora e salva todos os anexos, mas apenas adiciona texto à primeira mensagem. Alguém pode me ajudar com isso? Public Sub SaveAttachments() 'Update 20170523 Dim objOL As Outlook.Application Dim objMsg As Outlook.MailItem Dim objAttachments As Outlook.Attachments Dim objSelection As Outlook.Selection Dim I As Long Dim lngCount As Long Dim strFile As String Dim strFolderpath As String Set objOL = CreateObject("Outlook.Application") Set objSelection = objOL.ActiveExplorer.Selection strFolderpath = "C:\Users\brianp\Documents\Attachments\" Para cada objMsg Em objSelection Set objAttachments = objMsg.Attachments lngCount = objAttachments.Count 'Use isso para testar MsgBox "Subject = " & objMsg.Subject & " lngCount = " & objAttachments.Count If lngCount > 0 Then For I = lngCount To 1 Step -1 strFile = objAttachments.Item(I).FileName strFile = strFolderpath & strFile objAttachments.Item(I).SaveAsFile strFile Next I End If If objMsg.BodyFormat olFormatHTML Then objMsg.Body = vbCrLf & "Os arquivos anexados foram salvos em " & "" & strFile & "" & vbCrLf & objMsg.Body Else objMsg.HTMLBody = "" & "O arquivo anexado e(s) foram salvos em " & "" & strFile & "" & "" & objMsg.HTMLBody End If Next ExitSub: Set objAttachments = Nothing Set objMsg = Nothing Set objSelection = Nothing Set objOL = Nothing End Sub
Este comentário foi feito pelo moderador no site
Então, clico no link "Kutools for Outlook" e sou direcionado para uma página que não é isso, mas "Kutools - Combina mais de 300 funções e ferramentas avançadas para Microsoft Excel".

Nada sobre o Outlook. Perda de tempo.
Este comentário foi feito pelo moderador no site
Olá Davis,
Criamos um hiperlink incorreto. Obrigado pelo seu lembrete! E desculpe o transtorno trazido a você.
Este comentário foi feito pelo moderador no site
Obrigada. Isso me poupa muito tempo.
Este comentário foi feito pelo moderador no site
Eu apliquei este VBA a alguns e-mails. Como desfazer isso? Eu não quero essas mensagens em todos os e-mails (os arquivos foram salvos em .....). Por favor ajude.
Este comentário foi feito pelo moderador no site
Oi Priyanka, O código VBA não suporta a operação Undo. Desculpe pela inconveniência.
Este comentário foi feito pelo moderador no site
Obrigada! realmente me ajuda muito!!
Este comentário foi feito pelo moderador no site
O código VBA funcionou muito bem! Obrigado.
Este comentário foi feito pelo moderador no site
O código VBA funciona muito bem, mas não verifica nomes de arquivos duplicados - apenas os substitui. Isso pode ser adicionado?

ALan
Este comentário foi feito pelo moderador no site
Oi Alan,
O código que eu respondi a você antes tem alguns problemas. Adicionei novos códigos ao tutorial e o problema que você mencionou foi resolvido. Por favor, dê uma olhada e experimente. Obrigada!
Não há comentários postados aqui ainda
carregar mais
Deixe o seu comentário
Postando como convidado
×
Avalie esta postagem:
0   Personagens
Locais sugeridos