Ir para o conteúdo principal

Como renomear e salvar anexos de e-mail em uma pasta no Outlook?

No Outlook, você pode receber mensagens com anexos normalmente, e você tenta renomear os anexos da mensagem e salvá-los em uma pasta como mostrado na imagem abaixo? Obviamente, você pode salvá-los em uma pasta e renomeá-los um por um, mas, na verdade, tenho um código VBA que pode renomear rapidamente todos os anexos com o mesmo nome e depois salvá-los em uma pasta.
doc renomear salvar anexo 1

Renomear e salvar anexos com o mesmo nome em uma pasta

Renomeie e salve anexos em uma pasta com o Kutools para Outlook


Responder mensagem com anexos originais no Outlook

Como todos sabemos, os anexos anexados serão removidos da mensagem original quando você responder uma mensagem ao destinatário no Outlook. Se você quiser responder à massagem mantendo os anexos, pode tentar Kutools for Outlook's Responder com anexo função, ele pode responder uma mensagem com os anexos originais, também funciona para todos os messafe.    Clique para obter todos os recursos de teste gratuito por 60 dias!
 
doc responder com anexo
 
Kutools para Outlook: com dezenas de suplementos úteis do Outlook, gratuitos para testar sem limitação em 60 dias.
Guia Office - Habilite edição e navegação com guias no Microsoft Office, facilitando o trabalho
Kutools para Outlook - Impulsione o Outlook com mais de 100 recursos avançados para eficiência superior
Aumente seu Outlook 2021 - 2010 ou Outlook 365 com esses recursos avançados. Desfrute de um teste gratuito abrangente de 60 dias e melhore sua experiência de e-mail!

Renomear e salvar anexos com o mesmo nome em uma pasta

1. Selecione a mensagem cujos anexos deseja salvar e renomeie com o mesmo nome.

2. Pressione Alt + F11keys, então no Project1 painel, clique duas vezes Esta sessão do Outlook para criar um novo script em branco na seção certa, copie e cole o código nele.

VBA: renomear e salvar anexos

Public Sub SaveAttachsToDisk()
'UpdatebyExtendoffice20180521
Dim xItem As Object  'Outlook.MailItem
Dim xSelection As Selection
Dim xAttachment As Outlook.Attachment
Dim xFldObj As Object
Dim xSaveFolder As String
Dim xFSO As Scripting.FileSystemObject
Dim xFile As File
Dim xFilePath As String
Dim xNewName, xTmpName As String
Dim xExt As String
Dim xCount As Integer
On Error Resume Next
Set xFldObj = CreateObject("Shell.Application").browseforfolder(0, "Select a Folder", 0, 16)
Set xFSO = New Scripting.FileSystemObject
If xFldObj Is Nothing Then Exit Sub
xSaveFolder = xFldObj.Items.Item.Path & "\"
Set xSelection = Outlook.Application.ActiveExplorer.Selection
xNewName = InputBox("Attachment Name:", "Kutools for Outlook", xNewName)
If Len(Trim(xNewName)) = 0 Then Exit Sub
For Each xItem In xSelection
    For Each xAttachment In xItem.Attachments
        xFilePath = xSaveFolder & xAttachment.FileName
        xAttachment.SaveAsFile xFilePath
        Set xFile = xFSO.GetFile(xFilePath)
        xCount = 1
        Saved = False
        xExt = "." & xFSO.GetExtensionName(xFilePath)
        xTmpName = xNewName
        xNewName = xTmpName & xExt
        If xFSO.FileExists(xSaveFolder & xNewName) = False Then
            xFile.Name = xNewName
            xNewName = xTmpName
        Else
            xTmpName = Left(xNewName, Len(xNewName) - Len(xExt))
            While Saved = False
                xNewName = xTmpName & xCount & xExt
                If xFSO.FileExists(xSaveFolder & xNewName) = False Then
                    xFile.Name = xNewName
                    xNewName = xTmpName
                    Saved = True
                Else
                    xCount = xCount + 1
                End If
            Wend
        End If
    Next
Next
Set xFSO = Nothing
End Sub

doc renomear salvar anexos em uma pasta 2

3. Clique Ferramentas > Referências, na caixa de diálogo popping, verifique Tempo de execução de scripts da Microsoft caixa de seleção.

doc renomear salvar anexos em uma pasta 3 doc seta para a direita doc renomear salvar anexos em uma pasta 4

4. Clique OK, pressione F5 chave para executar o código, um Procurar pasta caixa de diálogo aparece para selecionar ou criar uma pasta para colocar anexos.
doc renomear salvar anexos em uma pasta 5

5. Clique OKe dê um nome para os anexos.
doc renomear salvar anexos em uma pasta 6

6. Clique OK, agora os anexos são renomeados com o mesmo nome, se houver duplicatas, as duplicatas serão adicionadas com números como sufixo.


Renomeie e salve anexos em uma pasta com o Kutools para Outlook

Na verdade, há um recurso no Kutools for Outlook - uma ferramenta útil de suplemento do Outlook pode renomear todos os anexos antes de salvar ou enviar.

Kutools for Outlook , Inclui  recursos e ferramentas poderosos para Microsoft Outlook 2016, 2013, 2010 e Office 365.

Livre Instalar Kutools para Outlook e siga as etapas abaixo:

1. Ative o e-mail no painel nagativo ou na caixa Mensagem como desejar, clique Kutools > Ferramentas de AnexoRenomear tudo.
doc renomear salvar anexo 2

2. Na caixa de diálogo pop-up, digite o novo nome que você usa para cada anexo. Clique OK, os anexos foram renomeados com novos nomes.
doc renomear salvar anexo 3 

3. Clique com o botão direito em um anexo e selecione Salvar todos os anexos, clique em OK e selecione uma pasta para salvar os anexos conforme necessário. Em seguida, os anexos renomeados foram salvos em uma pasta.
doc renomear salvar anexo 5 
doc renomear salvar anexo 5


Melhores ferramentas de produtividade de escritório

Kutools for Outlook - Mais de 100 recursos poderosos para turbinar seu Outlook

🤖 Assistente de correio AI: E-mails profissionais instantâneos com magia de IA – um clique para respostas geniais, tom perfeito, domínio multilíngue. Transforme o envio de e-mails sem esforço! ...

📧 Automação de e-mail: Fora do escritório (disponível para POP e IMAP)  /  Agendar envio de e-mails  /  CC/BCC automático por regras ao enviar e-mail  /  Encaminhamento automático (regras avançadas)   /  Adicionar saudação automaticamente   /  Divida automaticamente e-mails de vários destinatários em mensagens individuais ...

📨 Gestão de E-mail: Lembre-se facilmente de e-mails  /  Bloquear e-mails fraudulentos por assuntos e outros  /  Apagar Emails Duplicados  /  Pesquisa Avançada  /  Consolidar pastas ...

📁 Anexos PróSalvar em lote  /  Desanexar lote  /  Comprimir em Lote  /  Salvamento automático   /  Desanexação Automática  /  Compressão automática ...

???? Interface Mágica: 😊Mais emojis bonitos e legais   /  Aumente a produtividade do seu Outlook com visualizações com guias  /  Minimize o Outlook em vez de fechar ...

???? Maravilhas com um clique: Responder a todos com anexos recebidos  /   E-mails antiphishing  /  🕘Mostrar fuso horário do remetente ...

👩🏼‍🤝‍👩🏻 Contatos e calendário: Adicionar contatos em lote de e-mails selecionados  /  Dividir um grupo de contatos em grupos individuais  /  Remover lembretes de aniversário ...

Sobre Características 100 Aguarde sua exploração! Clique aqui para descobrir mais.

 

 

Comments (4)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Thanks, it is ridiculous that we have to go to these lengths to do something that should be handled by the application
This comment was minimized by the moderator on the site
Hi! How can this work if having multiple emails? Is this only for multiple attachments in same email? Thanks!
This comment was minimized by the moderator on the site
Hey there! Do you know how we can improve the below code to rename the file when saved?

Public Sub UnzipFileInOutlook(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "C:\Users\acheng\Desktop"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder
Set objAtt = Nothing
Next
End Sub
This comment was minimized by the moderator on the site
Hello, Lipe, may be this code can help you.

Private Sub CopyToDefaultCalendarFld(ByVal Item As Object)
Dim xCopiedAppointment As Outlook.AppointmentItem
Dim xMovedAppointment As Outlook.AppointmentItem
Dim xMeeting As MeetingItem
Dim xApoint As AppointmentItem
On Error Resume Next
If Item.Class = olAppointment Then
Set xApoint = Item
Set xCopiedAppointment = xApoint.Copy
Set xMovedAppointment = xCopiedAppointment.Move(GMovedCalendarFolder)
If xApoint.Subject <> xMovedAppointment.Subject Then
If InStr(1, xMovedAppointment.Subject, "Copy: ") > 0 Then
xMovedAppointment.Subject = VBA.Replace(xMovedAppointment.Subject, "Copy: ", "", 1, 1)
xMovedAppointment.Save
End If
End If
ElseIf Item.Class = olMeetingRequest Then
Set xMeeting = Item
Set xCopiedAppointment = xMeeting.GetAssociatedAppointment(True).Copy
Set xMovedAppointment = xCopiedAppointment.Move(GMovedCalendarFolder)
If xMeeting.Subject <> xMovedAppointment.Subject Then
If InStr(1, xMovedAppointment.Subject, "Copy: ") > 0 Then
xMovedAppointment.Subject = VBA.Replace(xMovedAppointment.Subject, "Copy: ", "", 1, 1)
xMovedAppointment.Save
End If
End If
xCopiedAppointment.Delete
End If
Set xCopiedAppointment = Nothing
End Sub
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations