☰

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

相关内容