☰

Outlook VBA - 日付に基づいてフォルダーを自動的に作成する

tag-icon • tag-icon microsoft-outlook vba microsoft-outlook-2016
Outlook VBA - 日付に基づいてフォルダーを自動的に作成する

PDF 添付ファイルを自動的に保存する VBA スクリプトを作成しました。日付に基づいて添付ファイルを保存する方法をご存知の方はいらっしゃいますか? たとえば、今日が 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-自動的にフォルダーを作成する][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

関連情報