☰

Outlook VBA — Автоматическое создание папки на основе даты

tag-icon • tag-icon microsoft-outlook vba microsoft-outlook-2016
Outlook VBA — Автоматическое создание папки на основе даты

Я создал скрипт VBA, который будет автоматически сохранять вложения в формате PDF. Кто-нибудь здесь знает, как мне сохранить вложение на основе даты? Например, сегодня 02-04-2020, затем этот конкретный пользователь отправил мне письмо с вложением в формате PDF, затем автоматически будет создана папка с именем 02-04-2020, и вся почта за этот день будет сохранена в этой папке. Затем на следующий день будет создана еще одна папка. Мне действительно нужно разделить входящие вложения по дате.

Вот что у меня есть на данный момент

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

решение1

Кто-то в codeproject.com помог мне решить мою проблему, и я хотел бы выразить признательность тому человеку, у которого имя пользователя @CHill60. Большое спасибо за помощь. Ниже приведен код от этого человека, и этот код решил мою проблему.

Вот ссылка на мой вопрос, опубликованный на codeproject.com [https://www.codeproject.com/Questions/5258321/Outlook-VBA-automatically-create-a-folder-based-on][1]

Вот полный код, который опубликовал @CHill60. Надеюсь, это может быть полезно другим.

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

Связанный контент