使用excel VBA获取outlook电子邮件项目，按日期限制

我编写了以下代码，当我想提取excel工作表中的outlook电子邮件项目时，它可以完美地工作，但当我想获取在特定日期收到的电子邮件时，它不起作用：

Sub getMail()
   Dim i As Long
    Dim arrHeader As Variant
    
    Dim olNS As Namespace
    Dim olInboxFolder As MAPIFolder
    Dim olItems As Items
    Dim olItem As Variant
    
    Set olNS = GetNamespace("MAPI")
    Set olInboxFolder = olNS.PickFolder 'Pick folder
    Set olItems = olInboxFolder.Items
      

    
    arrHeader = Array("Date Created", "SenderEmailAddress", "Subject", "Body")
    ThisWorkbook.Worksheets("Output").Range("A1").Resize(1, UBound(arrHeader) + 1).Value = arrHeader
    
    ActiveSheet.Range("E2", Range("E2").End(xlDown)).NumberFormat = "mm/dd/yyyy h:mm AM/PM"
    
    
    
    i = 1
    
sFilter = InputBox("Enter Date")
    
FilterString = "[ReceivedTime] > sFilter "
    
For Each olItem In olItems.Restrict(FilterString)
        ' MailItem
        If olItem.Class = olMail Then
        Set mi = olItem
        Debug.Print mi.ReceivedTime
            ThisWorkbook.Worksheets("Output").Cells(i + 1, "A").Value = olItems(i).ReceivedTime
                If olItems(i).SenderEmailType = "SMTP" Then
                    ThisWorkbook.Worksheets("Output").Cells(i + 1, "B").Value = olItems(i).SenderEmailAddress
                ElseIf olItems(i).SenderEmailType = "EX" Then
                    ThisWorkbook.Worksheets("Output").Cells(i + 1, "B").Value = olItems(i).Sender.GetExchangeUser.PrimarySmtpAddress
                    End If
            ThisWorkbook.Worksheets("Output").Cells(i + 1, "C").Value = olItems(i).Subject
            ThisWorkbook.Worksheets("Output").Cells(i + 1, "D").Value = olItems(i).Body
            
            i = i + 1
            On Error Resume Next
           
            
        ' ReportItem
        ElseIf olItem.Class = olReport Then
            ThisWorkbook.Worksheets("Output").Cells(i + 1, "A").Value = olItems(i).CreationTime
            ThisWorkbook.Worksheets("Output").Cells(i + 1, "B").Value = _
            olItems(i).PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0E04001E")  'PR_DISPLAY_TO
            ThisWorkbook.Worksheets("Output").Cells(i + 1, "C").Value = olItems(i).Subject
            i = i + 1
        End If
        
  
Next olItem
    
    ThisWorkbook.Worksheets("Output").Cells.EntireColumn.AutoFit
    
    MsgBox "Export complete.", vbInformation

    Set olItems = Nothing
    Set olInboxFolder = Nothing
    Set olNS = Nothing
End Sub

例如，我希望获取从2020年8月16日开始发送的所有电子邮件，或者获取特定日期范围内的所有电子邮件。

Private Sub getMail\u InputBoxDate（）
Private Sub getMail_InputBoxDate()
    
    Dim olNS As namespace
    Dim olFilterFolder As Folder
    
    Dim olItems As Items
    Dim olItem As Object
    Dim mi As mailItem
    
    Dim filterString As String
    
    Dim sDate1 As String
    Dim filterString1 As String
    
    Dim sDate2 As String
    Dim filterString2 As String
    
    Dim olItemsRes As Items
    
    Set olNS = GetNamespace("MAPI")
    
    Set olFilterFolder = olNS.PickFolder 'Pick folder
    
    Set olItems = olFilterFolder.Items
    olItems.Sort "[ReceivedTime]", True
    
    Debug.Print vbCr & "olItems.Count: " & olItems.Count
    
    sDate1 = InputBox("Enter Start Date", , "2020-09-14")
    'Debug.Print sDate1
    sDate1 = Format(sDate1 & " 00:00 AM", "DDDDD HH:NN")
    Debug.Print vbCr & "sDate1: " & sDate1
    
    ' Single quotes around variable.
    filterString1 = "[ReceivedTime] >= '" & sDate1 & "'"
    Debug.Print " filterString1: " & filterString1
    
    Set olItemsRes = olItems.Restrict(filterString1)
    Debug.Print " olItemsRes.Count: " & olItemsRes.Count
    
    sDate2 = InputBox("Enter date, one day after desired range.", , "2020-09-15")
    'Debug.Print sDate2
    sDate2 = Format(sDate2 & " 00:00 AM", "DDDDD HH:NN")
    Debug.Print vbCr & "sDate2: " & sDate2
    
    ' With single quotes around variable.
    filterString2 = "[ReceivedTime] < '" & sDate2 & "'"
    Debug.Print " filterString2: " & filterString2
    
    ' Option 1 - Restrict the previously restricted items
    Set olItemsRes = olItemsRes.Restrict(filterString2)
    Debug.Print " olItemsRes.Count: " & olItemsRes.Count
    
    Debug.Print
    For Each olItem In olItemsRes
        ' MailItem
        If olItem.Class = olMail Then
            Set mi = olItem
            Debug.Print mi.ReceivedTime & " " & mi.Subject
        End If
    Next olItem
    
    ' Option 2 - Combine two working filters into one
    filterString = filterString1 & " AND " & filterString2
    Debug.Print vbCr & "filterString combined: " & filterString
    ' Restrict the original items once
    Set olItemsRes = olItems.Restrict(filterString)
    Debug.Print "olItemsRes.Count: " & olItemsRes.Count
    Debug.Print
    For Each olItem In olItemsRes
        ' MailItem
        If olItem.Class = olMail Then
            Set mi = olItem
            Debug.Print mi.ReceivedTime & " " & mi.Subject
        End If
    Next olItem
    
    Debug.Print vbCr & "Done."

End Sub

Dim-olNS作为名称空间
Dim olFilterFolder作为文件夹
作为物品的物品
作为对象
将mi设置为邮件项
暗过滤器字符串作为字符串
Dim sDate1作为字符串
Dim filterString1作为字符串
尺寸sDate2为字符串
Dim filterString2作为字符串
将MSRES作为项目
设置olNS=GetNamespace（“MAPI”）
设置olFilterFolder=olNS.PickFolder“拾取文件夹”
设置oliterms=olFilterFolder.Items
olItems.Sort“[ReceivedTime]”，True
调试.打印vbCr&“olItems.Count:”&olItems.Count
sDate1=输入框（“输入开始日期”，“2020-09-14”）
'Debug.Print sDate1
sDate1=格式（sDate1和“00:00 AM”，“DDDDD HH:NN”）
调试。打印vbCr和“sDate1:”&sDate1
'围绕变量的单引号。
filterString1=“[ReceivedTime]>=”&sDate1&“
调试。打印“filterString1:”&filterString1
设置olItemsRes=olItems.Restrict（过滤器字符串1）
Debug.Print“olItemsRes.Count:&olItemsRes.Count
sDate2=输入框（“输入日期，在所需范围后一天。”，“2020-09-15”）
'Debug.Print sDate2
sDate2=格式（sDate2和“00:00 AM”，“DDDDD HH:NN”）
调试。打印vbCr和“sDate2:”&sDate2
'并在变量周围加上单引号。
filterString2=“[ReceivedTime]<”&sDate2&“
调试。打印“filterString2:”&filterString2
'选项1-限制以前限制的项目
设置olItemsRes=olItemsRes.Restrict（过滤器字符串2）
Debug.Print“olItemsRes.Count:&olItemsRes.Count
调试。打印
对于OlitemRes中的每个olItem
'邮件项目
如果olItem.Class=olMail，则
设置mi=m
Debug.Print mi.ReceivedTime&“&mi.Subject
如果结束
下一代
'选项2-将两个工作过滤器合并为一个
filterString=filterString 1&“和”&filterString 2
调试。打印vbCr和“filterString组合：”&filterString
'将原始项目限制一次
设置olItemsRes=olItems.Restrict（过滤器字符串）
Debug.Print“olItemsRes.Count:&olItemsRes.Count
调试。打印
对于OlitemRes中的每个olItem
'邮件项目
如果olItem.Class=olMail，则
设置mi=m
Debug.Print mi.ReceivedTime&“&mi.Subject
如果结束
下一代
调试。打印vbCr&“完成”
端接头

---

这只是向用户输入日期添加时间。

FilterString=“[ReceivedTime]>sFilter”

-这不应该是

FilterString=“[ReceivedTime]>”&sFilter&“

”更改了它，但它不起作用。条件无效。