☰

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

相關內容