Desanexar no outlook, incluindo a data no nome do arquivo

Lógica de programação

Boa tarde, Estou com uma dificuldade, possuo a macro abaixo que desanexa os arquivos no Outlook dos e-mail que possuem anexo, e numera os anexo sem sobrepor, gostaria de colocar a data do e-mail ou a data do arquivo (não do dia que estou salvando) no nome do arquivo, ao invés de numerar, alguém consegue ajudar?

Macro utilizada

Public Sub Desanexar_SEMSOBREPOR()
Dim ObjApp As Outlook.Application
Dim Pasta_outlook As Outlook.MAPIFolder
Dim ObjItem As Object
Dim Arq_anexo As Outlook.Attachment
Dim Pasta As String
Dim NomeArquivo As String
Dim Extensao As String
Dim NovoNomeArquivo As String
Dim Contador As Integer

'Pasta onde serão gravados os arquivos anexos dos emails:
Pasta = "C:\Arquivos"

Set ObjApp = Outlook.Application
Set Pasta_outlook = ObjApp.ActiveExplorer.CurrentFolder

If MsgBox("Deseja desanexar todos os arquivos da pasta " & Pasta_outlook.Name, vbYesNo) = vbNo Then Exit Sub

For Each ObjItem In Pasta_outlook.Items
    DoEvents
    'Se o objeto é do tipo email, começa a desanexar os arquivos
    If ObjItem.Class = olMail Then
        For Each Arq_anexo In ObjItem.Attachments
            DoEvents

            ' Pega o nome do arquivo e a extensão
            NomeArquivo = Left(Arq_anexo.FileName, InStrRev(Arq_anexo.FileName, ".") - 1)
            Extensao = Mid(Arq_anexo.FileName, InStrRev(Arq_anexo.FileName, "."))

            ' Garante que o novo nome do arquivo seja único
            NovoNomeArquivo = Pasta & "\" & Arq_anexo.FileName
            Contador = 1

            While Dir(NovoNomeArquivo) <> ""
                NovoNomeArquivo = Pasta & "\" & NomeArquivo & "_" & Contador & Extensao
                Contador = Contador + 1
            Wend

            ' Salva o anexo com o novo nome
            Arq_anexo.SaveAsFile NovoNomeArquivo
        Next Arq_anexo
    End If
Next ObjItem

MsgBox "Processo finalizado!", vbOKOnly

End Sub

Foto de Silvio B.
Silvio perguntou há 1 mês
1 resposta
Professor Vinícius B.
Identidade verificada
  • CPF verificado
  • E-mail verificado
Respondeu há 2 dias
Contatar Vinícius

Para modificar a macro que você forneceu de forma que o nome do arquivo salvo inclua a data do e-mail (ou a data do arquivo anexado), você pode fazer algumas alterações na parte do código onde a variável NovoNomeArquivo é definida. Aqui está a macro atualizada que inclui a data do e-mail no nome do arquivo:

```vba Public Sub Desanexar_SEMSOBREPOR() Dim ObjApp As Outlook.Application Dim Pasta_outlook As Outlook.MAPIFolder Dim ObjItem As Object Dim Arq_anexo As Outlook.Attachment Dim Pasta As String Dim NomeArquivo As String Dim Extensao As String Dim NovoNomeArquivo As String Dim Contador As Integer Dim DataEmail As String

'Pasta onde serão gravados os arquivos anexos dos emails:
Pasta = "C:\Arquivos"

Set ObjApp = Outlook.Application
Set Pasta_outlook = ObjApp.ActiveExplorer.CurrentFolder

If MsgBox("Deseja desanexar todos os arquivos da pasta " & Pasta_outlook.Name, vbYesNo) = vbNo Then Exit Sub

For Each ObjItem In Pasta_outlook.Items
    DoEvents
    'Se o objeto é do tipo email, começa a desanexar os arquivos
    If ObjItem.Class = olMail Then
        ' Formata a data do email (exemplo: AAAA-MM-DD)
        DataEmail = Format(ObjItem.ReceivedTime, "yyyy-mm-dd")
        For Each Arq_anexo In ObjItem.Attachments
            DoEvents

            ' Pega o nome do arquivo e a extensão
            NomeArquivo = Left(Arq_anexo.FileName, InStrRev(Arq_anexo.FileName, ".") - 1)
            Extensao = Mid(Arq_anexo.FileName, InStrRev(Arq_anexo.FileName, "."))

            ' Garante que o novo nome do arquivo seja único
            NovoNomeArquivo = Pasta & "\" & NomeArquivo & "_" & DataEmail & Extensao
            Contador = 1

            While Dir(NovoNomeArquivo) <> ""
                NovoNomeArquivo = Pasta & "\" & NomeArquivo & "_" & DataEmail & "_" & Contador & Extensao
                Contador = Contador + 1
            Wend

            ' Salva o anexo com o novo nome
            Arq_anexo.SaveAsFile NovoNomeArquivo
        Next Arq_anexo
    End If
Next ObjItem

MsgBox "Processo finalizado!", vbOKOnly

End Sub ```

O que foi alterado

  1. Data do E-mail: Adicionei uma nova variável chamada DataEmail que formata a data do e-mail usando Format(ObjItem.ReceivedTime, "yyyy-mm-dd"). Isso obtém a data recebida do e-mail e a formata para um padrão que não causa problemas em nomes de arquivos.

  2. Modificar NovoNomeArquivo: Na linha onde NovoNomeArquivo é definido, inclui a DataEmail no seu nome. Isso significa que cada arquivo salvo terá a data do e-mail no formato NomeArquivo_yyyy-mm-dd.extensão.

  3. Lidar com Nomes Duplicados: Caso já exista um arquivo com o mesmo nome e a mesma data, o script continuará a adicionar um número incremental (_1_2, etc.) ao final do nome do arquivo para garantir a unicidade.

Com essas alterações, ao executar a macro, você obterá os arquivos com a data do e-mail incluída no nome, ao invés de uma numeração sequencial.

Essa dúvida foi respondida
Crie sua conta grátis e receba os benefícios
Veja respostas de dúvidas enviadas por outros alunos
Envie suas dúvidas e a Minerva IA responde na hora
Ver resposta

Envie uma dúvida e receba resposta imediata

Respostas da Minerva IA e de professores particulares
Enviar dúvida
Envie suas dúvidas por WhatsApp

Tire dúvidas com a Minerva IA diretamente pelo WhatsApp

Simples e prático
Respostas instantâneas
Pergunte usando foto, áudio ou texto
Envie suas dúvidas pelo App
Tenha sua atividade, tarefa, lista de exercícios, ou projeto resolvida por um professor especialista
Você define o prazo
Interação com o professor por chat
Se não gostar da resolução, reembolsamos
Enviar tarefa