VBA-Excel＆Outlook;如何检索在特定日期收到的邮件列表并在其中保存附件

Question

1. 在Excel中，我想在按下按钮时生成一个名为“今天的日期”的文件夹
2. 然后，在特定日期检索收到的电子邮件以获取邮件中的附件
3. 重命名附件文件。 在我的Excel工作表中，有一些信息，例如doc_num，doc_name和Received_date。 如果附件文件名等于doc_name，则将附件文件重命名为doc_num_doc_name_received_date。

这就是我想做的。

我获得了somw源代码，因此过程1已完成。 但是我无法执行步骤2。

Public Sub SaveAttachment(FPath As String, UserDate As Date)
    Dim OutlookApp As Object 'Object 생성
    Dim ONameSpace As Object
    Dim OutlookMail As Object 'GetItems
    Set OutlookApp = CreateObject("Outlook.Application")
    Set ONameSpace = OutlookApp.GetNamespace("MAPI")
    Set OutlookMail = OutlookApp.CreateItem(0)
    Dim Atmt As Attachment
    Dim FileName As String
    Dim TimeCrit    As Date
    Dim OItems As Outlook.Items
    Dim OInbox As Outlook.Items
    TimeCrit = UserDate
    Set OInbox = ONameSpace.GetDefaultFolder(olFolderInbox).Items
    Set OItems = OInbox.Restrict("[ReceivedTime] >= """ & Format(TimeCrit, "yyyy-mm-dd") & """")
    Dim MailItem As Object
    Dim OItem As Object
    Dim Found As Boolean
    Found = False
    For Each OItem In OItems
        Debug.Print "6."; OItem.Subject
            Dim dRT As Date
            'dRT = olMail.ReceivedTime
            dRT = OItem.ReceivedTime
        For Each Atmt In OItem.Attachments
            Debug.Print "dRT : "; dRT
            FileName = FPath & "\" & Format(dRT, "yyyy-mm-dd") & "-" & Atmt.FileName
            Atmt.SaveAsFile FileName
            i = i + 1
        Next Atmt
    Next OItem
    Set OutlookApp = Nothing
End Sub

Sub MakeNewDirectory()
    Dim Username As String
    Dim pathName As String
    Dim FPath As String
    Dim dif As Integer
    Dim UserDt As Date
    Username = InputBox("ID number", "Input your ID number", "qxxxxxx")
    UserDt = InputBox("Date", "This is the date you want to search", "yyyy-mm-dd")
    pathName = "C:\Users\" & Username & "\Downloads\"
    today = Format(Now, "yyyy-mm-dd")
    FPath = pathName & today & "-" & Username
    If Len(Dir(FPath, vbDirectory)) = 0 Then MkDir FPath
    dif = DateDiff("d", UserDt, today)
    Call SaveAttachment(FPath, UserDt)
    Call openExcel(pathName)
End Sub