☰

Outlook VBA - Automatisches Erstellen eines Ordners basierend auf dem Datum

tag-icon • tag-icon microsoft-outlook vba microsoft-outlook-2016
Outlook VBA - Automatisches Erstellen eines Ordners basierend auf dem Datum

Ich habe ein VBA-Skript erstellt, das PDF-Anhänge automatisch speichert. Weiß hier jemand, wie ich Anhänge datumsabhängig speichern kann? Heute ist beispielsweise der 02.04.2020. Dieser bestimmte Benutzer hat mir eine E-Mail mit einem PDF-Anhang geschickt. Anschließend wird automatisch ein Ordner mit dem Namen 02.04.2020 erstellt und alle E-Mails dieses Tages werden in diesem Ordner gespeichert. Am nächsten Tag wird dann ein weiterer Ordner erstellt. Ich muss die eingehenden Anhänge wirklich nach Datum trennen.

Hier ist, was ich bisher habe

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

Antwort1

Jemand bei codeproject.com hat mir geholfen, mein Problem zu lösen, und ich möchte dieser Person mit dem Benutzernamen @CHill60 danken. Vielen Dank für Ihre Hilfe. Der folgende Code stammt von dieser Person und dieser Code hat mein Problem gelöst.

Hier ist ein Link zu meiner geposteten Frage auf codeproject.com [https://www.codeproject.com/Questions/5258321/Outlook-VBA-automatically-create-a-folder-based-on][1]

Hier ist der vollständige Code, den @CHill60 gepostet hat. Ich hoffe, dass er für andere hilfreich sein kann.

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

verwandte Informationen