我已经创建了用于通过 Outlook 中的日期输入框归档电子邮件的工作代码。但是，过滤器仅适用于当天。在此之前的任何一天，它都找不到符合匹配条件的任何电子邮件。
它的工作原理是将输入的日期（必须提交的报告的日期）转换为收到电子邮件的日期（第二天）。但是，此代码只能正确过滤今天收到的电子邮件。它可以正确过滤它们，但无法找到之前的任何日期。
我已使用 2x 限制过滤器选项来选择使用 Microsoft 建议格式的日期。我尝试调整过滤，使其仅使用下限，并且我检查过，在删除日期过滤器时，它仍然可以找到来自发件人的电子邮件。一旦将日期过滤器应用于当天之前收到的任何邮件，它就无法再找到该邮件。
Sub EmailSort()
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.NameSpace
Dim Mfolder As Outlook.MAPIFolder
Dim InboxFolder As Outlook.MAPIFolder, DestFolder As Outlook.MAPIFolder, SubFolder As Outlook.MAPIFolder
Dim olItems As Outlook.Items
Dim olMail As Outlook.MailItem
Dim sharedmailbox As Outlook.Recipient
Dim olattachment As Outlook.Attachments
Dim sendername As String, datestring As String, attachname As String
Dim i As Long, cont As Long, ii As Long
Dim sfilter As String, ssavepath As String, sdate As String, spathdate As String, yearr As String
Dim dateformat As Date
Dim NSWB As Boolean
Set olApp = Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
Set sharedmailbox = olNamespace.CreateRecipient("admin")
Set InboxFolder = olNamespace.GetSharedDefaultFolder(sharedmailbox, olFolderInbox)
Set DestFolder = InboxFolder.Folders("STATES")
dateformat = InputBox("Please Choose the date you'd like to sort (dd/mm/yyyy)", "Date Selector")
spathdate = Replace(dateformat, "/", "")
yearr = Right(spathdate, 2)
sdate = Replace(dateformat, "/", " ")
spathdate = Replace(spathdate, Right(spathdate, 4), yearr)
If Len(spathdate) < 6 Then sdate = "0" & sdate
If Len(spathdate) < 6 Then spathdate = "0" & spathdate
dateformat = dateformat + 1
sfilter = "[Sendername] = ""senderemail"""
sfilter = sfilter & " And [SentOn] < '" & Format(dateformat + 1, "dddd h:nn AMPM") & "'"
sfilter = sfilter & " And [SentOn] > '" & Format(dateformat, "dddd h:nn AMPM") & "'"
Set olItems = InboxFolder.Items.Restrict(sfilter)
i = olItems.Count
If olItems.Count > 0 Then
InputBox 返回一个字符串。转换为日期。
和/或
Format(dateFormat + 1, "ddddd h:nn AMPM")
Format(dateFormat, "ddddd h:nn AMPM")
Option Explicit
Sub EmailFilter()
Dim inboxFolder As folder
Dim olItems As Items
Dim dateString As String
Dim dateFormat As Date
Dim sfilter As String
Set inboxFolder = Session.GetDefaultFolder(olFolderInbox)
' Day and month can swap unexpectedly.
' When testing use a day less than 13 and a month different than day.
'dateString = InputBox("Please choose the date you'd like to filter (dd/mm/yyyy)", "Date Selector")
dateString = InputBox("Choose date to filter (dd/mm/yyyy)", "Date Selector", "12/05/2024")
Debug.Print "dateString...............................................: " & dateString
' I get 2024-12-05, day and month interchanged. Can occur when day is less than 13.
dateFormat = CDate(dateString)
Debug.Print "CDate(dateString)........................................: " & dateFormat
' I get 2024-12-05, day and month interchanged. Can occur when day is less than 13.
dateFormat = CDate(year(dateString) & "-" & Month(dateString) & "-" & day(dateString))
Debug.Print "CDate(year(dateString)-Month(dateString)-day(dateString)): " & dateFormat
' I get 2024-12-05, day and month interchanged. Can occur when day is less than 13.
dateFormat = CDate(year(dateString) & "-" & Month(dateString) & "-" & day(dateString))
Debug.Print "CDate(Month(dateString)-day(dateString)-year(dateString)): " & dateFormat
' I get 2024-05-12
dateFormat = CDate(day(dateString) & "-" & Month(dateString) & "-" & year(dateString))
Debug.Print "CDate(day(dateString)-Month(dateString)-year(dateString)): " & dateFormat
Debug.Print
sfilter = "[Sendername] = ""sender name"""
'sfilter = sfilter & " And [SentOn] < '" & Format(dateformat + 1, "dddd h:nn AMPM") & "'"
sfilter = sfilter & " And [SentOn] < '" & Format(dateFormat + 1, "ddddd h:nn AMPM") & "'"
'sfilter = sfilter & " And [SentOn] > '" & Format(dateformat, "dddd h:nn AMPM") & "'"
sfilter = sfilter & " And [SentOn] >= '" & Format(dateFormat, "ddddd h:nn AMPM") & "'"
Debug.Print sfilter
Debug.Print
Set olItems = inboxFolder.Items
Debug.Print "Original olItems.count..: " & olItems.count
Set olItems = inboxFolder.Items.Restrict(sfilter)
Debug.Print "Restricted olItems.count: " & olItems.count
Debug.Print
End Sub