首先，迭代循环中的所有项以获取特定日期的项是不正确的。相反，您需要使用Items类的Find/FindNext或Restrict方法。你可以在我为技术博客写的文章中阅读更多关于这些方法的内容：

• How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
• How To: Use Restrict method to retrieve Outlook mail items from a folder

如果你需要处理所有的子文件夹，你必须递归地遍历子文件夹。例如：

Private Sub processFolder(ByVal oParent As Outlook.MAPIFolder)

   Dim oFolder As Outlook.MAPIFolder
   Dim oMail As Outlook.MailItem

   For Each oMail In oParent.Items
     'Get your data here ...
   Next

   If (oParent.Folders.Count > 0) Then
     For Each oFolder In oParent.Folders
        processFolder oFolder
     Next
   End If
End Sub

但是一个更好的解决方案，满足您的所有需求是Application类的AdvancedSearch方法。在Outlook中使用AdvancedSearch方法的主要优点是：

• 搜索在另一个线程中执行。您不需要手动运行另一个线程，因为AdvancedSearch方法会在后台自动运行它。
• 可以搜索任何项目类型：邮件、约会、日历、笔记等。在任何位置，即超出了某个文件夹的范围。Restrict和Find/FindNext方法可以应用于特定的Items集合（请参阅Outlook中Folder类的Items属性）。
• 完全支持DASL查询（自定义属性也可用于搜索）。若要提高搜索性能，如果为商店启用了即时搜索，则可以使用即时搜索关键字（请参见Store类的IsInstantSearchEnabled属性）。
• 您可以随时使用Search类的Stop方法停止搜索过程。

在Advanced search in Outlook programmatically: C#, VB.NET文章中阅读更多关于它的内容。

编辑

在循环之前初始化计数器i。我不小心把它留在了原来的地方。

原创

这比你想象的要简单我将您的代码放在Do ... Loop中，以允许用户继续选择文件夹，直到用户单击Cancel。它退出循环。
我删除了你的大部分报告线只是为了保持这一点。一旦你确信这是有效的，就把它们加回去。

Option Explicit  ' Should be the first line in every module

Sub getDataFromOutlookChoiceFolder()
    Dim OutlookApp As Outlook.Application
    Dim OutlookNameSpace As Namespace
    Dim Folder As MAPIFolder
    Dim OutlookMail As Variant
    Dim i As Long
    Dim rngName As Name
    Dim wkshSheet1 As Worksheet  ' Dim this variable; Option Explicit will force that
    
    Set OutlookApp = New Outlook.Application
    Set OutlookNameSpace = OutlookApp.GetNamespace("MAPI")
    
    Set wkshSheet1 = ActiveWorkbook.Worksheets("Sheet1") ' Define for your needs
    wkshSheet1.Cells.Clear
    For Each rngName In ActiveWorkbook.Names
        rngName.Delete
    Next

    ' Shortened from original to save space; replace your original lines here
    Range("A1").Name = "receivedtime"
    Range("A1") = "Received Time"
    Range("B1").Name = "From"
    Range("B1") = "From"

    i = 1  ' EDIT: initialize i before loop

    ' Loop allowing user to choose folders
    Do
        Set Folder = OutlookNameSpace.PickFolder
        
        If Folder Is Nothing Then ' User clicked Cancel, bail out
            Exit Do
        End If
        
        ' Empty folder selected; (commented to allow loop to continue)
        If Folder.Items.Count = 0 Then
'            MsgBox "No emails. Exiting procedure!"
'            Exit Sub
        End If
        
'        i = 1  ' EDIT: MOVE THIS BEFORE LOOP
        
        For Each OutlookMail In Folder.Items
            If OutlookMail.ReceivedTime >= Range("email_Receipt_Date").Value And _
                    OutlookMail.ReceivedTime <= Range("email_end_date").Value Then
                
                Range("receivedtime").Offset(i, 0).Value = OutlookMail.ReceivedTime
                Range("receivedtime").Offset(i, 0).Columns.AutoFit
                Range("receivedtime").Offset(i, 0).VerticalAlignment = xlTop
                Range("from").Offset(i, 0).Value = OutlookMail.SenderName
                Range("from").Offset(i, 0).Columns.AutoFit
                Range("from").Offset(i, 0).VerticalAlignment = xlTop
                
                i = i + 1
            End If
        Next OutlookMail
        
    Loop  ' Choose next folder
    
    Set Folder = Nothing
    Set OutlookNameSpace = Nothing
    Set OutlookApp = Nothing
    
    MsgBox ("Completed")
End Sub