☰

Outlook VBA - Crie automaticamente uma pasta com base na data

tag-icon • tag-icon microsoft-outlook vba microsoft-outlook-2016
Outlook VBA - Crie automaticamente uma pasta com base na data

Eu criei um script VBA que salvará automaticamente anexos em PDF. Alguém aqui sabe como posso salvar o anexo com base na data? Por exemplo, hoje é 02/04/2020, então este usuário específico me enviou um e-mail com um anexo em PDF e automaticamente uma pasta será criada com o nome 02/04/2020 e todos os e-mails daquele dia serão armazenados nessa pasta. Então, no dia seguinte, outra pasta será criada. Eu realmente preciso separar os anexos recebidos por data.

Aqui está o que tenho até agora

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim dateFormat
dateFormat = Format(Now, "yyyy-mm-dd H-mm")
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim getsender As String
saveFolder = "C:\Users\UserName\Desktop\Attachments\"
     For Each objAtt In itm.Attachments
          If InStr(objAtt.FileName, ".pdf") > 0 Then
          objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
          Set objAtt = Nothing
          End If
     Next
End Sub

Responder1

Alguém em codeproject.com me ajudou a resolver meu problema e gostaria de agradecer a essa pessoa que tem o nome de usuário @ CHill60. Muito obrigado por me ajudar. O código abaixo é dessa pessoa e esse código resolveu meu problema.

Aqui está um link da minha pergunta postada em codeproject.com [https://www.codeproject.com/Questions/5258321/Outlook-VBA-automatically-create-a-folder-based-on][1]

Aqui está o código completo @CHill60 postado. Espero que isso possa ser útil para outras pessoas.

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim dateFormat As String
    dateFormat = Format(itm.CreationTime, "mm-dd-yyyy")

    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim getsender As String

    saveFolder = "C:\Users\Username\Desktop\DLFolder\" & dateFormat & "\"

    CreateFolderIfNotExists saveFolder

    For Each objAtt In itm.Attachments
        If InStr(objAtt.FileName, ".pdf") > 0 Then
            objAtt.SaveAsFile saveFolder & objAtt.DisplayName
        End If

     Next
End Sub


Public Sub CreateFolderIfNotExists(folderName As String)
    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")

    If Not fs.folderexists(folderName) Then
        fs.createfolder (folderName)
    End If
End Sub

informação relacionada