当月邮件的 DASL 筛选器还会返回上个月最后一天的项目

Question

我使用DASL过滤器来搜索上个月标记为已完成的邮件。

它还返回上个月最后一天标记的项目(所以我为九月过滤器获得了一些八月项目(。此外，如果时间发生变化(9月最后一天的物品(，我不确定9月标记的所有物品是否都会被提取。

我想这与应用程序中的标志时间和服务器上存储的时间之间的时间差有关。

Option Explicit
Option Base 1
Sub LoopInFolder()
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Dim oa As Outlook.Application
Dim om As Outlook.MailItem
Dim m As Outlook.Namespace
Dim f As Outlook.Folder
Dim i As Object
Dim ws As Worksheet
Dim mcount As Byte
Dim mailboxes(1 To 3) As Variant

Set oa = New Outlook.Application
Set m = oa.GetNamespace("MAPI")

Set mailboxes(1) = 'folders
ThisWorkbook.Activate
mcount = 1
For Each ws In Worksheets
With ws
.Cells.Clear
.Activate
.Range("A1").Value = "Sender name"
.Range("B1").Value = "Mail title"
.Range("C1").Value = "Category"
.Range("D1").Value = "Processed by"
.Range("E1").Value = "Date received"
.Range("F1").Value = "Completed date"
.Range("A2").Activate
End With
For Each i In mailboxes(1).Items.Restrict("@SQL=%lastmonth(""http://schemas.microsoft.com/mapi/proptag/0x10910040"")%")
If i.Class = 43 Then
ActiveCell.Value = i.SenderName
ActiveCell.Offset(0, 1) = i.Subject
ActiveCell.Offset(0, 2) = i.Categories
ActiveCell.Offset(0, 3) = i.Categories
ActiveCell.Offset(0, 4) = i.ReceivedTime
ActiveCell.Offset(0, 5) = i.TaskCompletedDate
End If
ActiveCell.Offset(1, 0).Activate
Next
mcount = mcount + 1
Next

With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

Answer 1

限制过滤器可以这样构建：

Sub LoopInFolder_UTC()
' https://stackoverflow.com/questions/48308994/using-restrict-method-for-emails-within-a-specified-date
Dim olApp As outlook.Application
Dim olFolder As outlook.Folder

Dim olItems As outlook.Items
Dim myItems As outlook.Items
Dim myitem As Object

Dim myFolder As outlook.Folder

Dim firstDayOfLastMonth As Long
Dim lastDayOfOfLastMonth As Long

Dim firstDayOfCurrentMonth As Long

Dim myUTC As Long

Dim DateStart As String
Dim DateEnd As String

Dim filter1 As String
Dim filter2 As String
Dim filter3 As String

Set olApp = New outlook.Application
Set myFolder = Session.GetDefaultFolder(olFolderInbox)

Set olItems = myFolder.Items

Debug.Print "Today is " & Date

' https://stackoverflow.com/questions/15430035/how-to-get-start-and-end-of-previous-month-in-vb
lastDayOfOfLastMonth = DateSerial(Year(Date), Month(Date), 0)
Debug.Print "lastDayOfOfLastMonth: " & lastDayOfOfLastMonth
Debug.Print "lastDayOfOfLastMonth: " & Format(lastDayOfOfLastMonth, "yyyy-mm-dd hh:mm AM/PM")

firstDayOfLastMonth = lastDayOfOfLastMonth - day(lastDayOfOfLastMonth) + 1
Debug.Print "firstDayOfLastMonth.: " & firstDayOfLastMonth
Debug.Print "firstDayOfLastMonth.: " & Format(firstDayOfLastMonth, "yyyy-mm-dd hh:mm AM/PM")
DateStart = Format(CDate(firstDayOfLastMonth), "yyyy-mm-dd hh:mm AM/PM")

' DateEnd is the beginning of the next day after applicable period
firstDayOfCurrentMonth = DateAdd("d", 1, lastDayOfOfLastMonth)
DateEnd = Format(CDate(firstDayOfCurrentMonth), "yyyy-mm-dd hh:mm AM/PM")

Debug.Print
Debug.Print "** Dates not adjusted **"
Debug.Print "DateStart: " & DateStart
Debug.Print "DateEnd..: " & DateEnd

filter1 = "[ReceivedTime] > """ & DateStart & """"
Debug.Print vbCr & "filter1: " & filter1

Set myItems = olItems.Restrict(filter1)
Debug.Print myItems.count

filter2 = "[ReceivedTime] < """ & DateEnd & """"
Debug.Print vbCr & "filter2: " & filter2
Set myItems = myItems.Restrict(filter2)
Debug.Print myItems.count
' old FlagStatus documentation
' https://learn.microsoft.com/en-us/previous-versions/office/developer/office-2010/bb644164(v=office.14)

' FlagStatus: Deprecated - replaced by FlagRequest
' 0 - olNoFlag       - FlagRequest text none
' 1 - olFlagComplete - FlagRequest text unchanged
' 2 - olFlagMarked   - FlagRequest text default is "Follow up"

filter3 = "[FlagStatus] = 1"
' For testing - to get more results
'filter3 = "[FlagStatus] <> 0"
'filter3 = "[FlagStatus] = 0"
Debug.Print vbCr & "filter3: " & filter3
Set myItems = myItems.Restrict(filter3)
Debug.Print myItems.count

For Each myitem In myItems
Debug.Print myitem.ReceivedTime & ": " & myitem.subject
Next myitem

' ** UTC adjustment **
Debug.Print
Debug.Print "** UTC adjustment **"
myUTC = 4 ' change to your own

DateStart = Format(DateAdd("h", -myUTC, CDate(firstDayOfLastMonth)), "yyyy-mm-dd hh:mm AM/PM")
Debug.Print "DateStart: " & DateStart
' DateEnd is the beginning of the next day after applicable period
DateEnd = Format(DateAdd("h", -myUTC, CDate(firstDayOfCurrentMonth)), "yyyy-mm-dd hh:mm AM/PM")
Debug.Print "DateEnd..: " & DateEnd
Set olItems = myFolder.Items
filter1 = "[ReceivedTime] > """ & DateStart & """"
Debug.Print vbCr & "filter1: " & filter1
Set myItems = olItems.Restrict(filter1)
Debug.Print myItems.count

filter2 = "[ReceivedTime] < """ & DateEnd & """"
Debug.Print vbCr & "filter2: " & filter2
Set myItems = myItems.Restrict(filter2)
Debug.Print myItems.count

Debug.Print vbCr & "filter3: " & filter3
Set myItems = myItems.Restrict(filter3)
Debug.Print myItems.count

For Each myitem In myItems
Debug.Print myitem.ReceivedTime & ": " & myitem.subject
Next myitem
End Sub

过滤器可以组合成一个，但这样更容易跟踪和调试。