按主题/日期条件导入Outlook邮件至Excel：解决类型不匹配错误

先来说你遇到的「Type MisMatch」错误——这大概率是因为你目标Outlook文件夹里不全是标准邮件（MailItem），比如混了会议邀请、任务请求这类非邮件对象，循环的时候直接把它们当成MailItem处理就会触发类型不匹配。而且你说有部分邮件成功导入，也完全符合这个逻辑：那些成功的都是标准邮件，碰到非邮件对象就报错停住了。

先给你修正基础代码，解决这个错误：

Sub GetFromInbox()
    Dim olapp As Outlook.Application
    Dim olNs As Outlook.Namespace
    Dim Fldr As Outlook.MAPIFolder
    Dim olItem As Object ' 先声明为通用对象，避免类型不匹配
    Dim olMail As Outlook.MailItem
    Dim Pst_Folder_Name As String, MailboxName As String
    Dim i As Long
    Dim ws As Worksheet
    
    ' 初始化Excel工作表，避免每次手动选择
    Set ws = ThisWorkbook.Sheets("Sheet1") ' 替换成你的目标工作表名
    ws.Cells.Clear ' 清空旧数据
    
    ' 初始化Outlook对象
    Set olapp = New Outlook.Application
    Set olNs = olapp.GetNamespace("MAPI")
    
    ' 替换成你的邮箱名称和目标文件夹名，比如"我的邮箱"和"收件箱"
    MailboxName = "xx...@xxx.com"
    Pst_Folder_Name = "收件箱"
    Set Fldr = olNs.Folders(MailboxName).Folders(Pst_Folder_Name)
    
    i = 2 ' 从第二行开始写数据，第一行留作表头
    ' 遍历文件夹内所有对象，先判断是否为标准邮件
    For Each olItem In Fldr.Items
        If TypeName(olItem) = "MailItem" Then
            Set olMail = olItem
            ' 写入邮件数据，可根据需求调整列对应内容
            ws.Cells(i, 1).Value = olMail.Subject
            ws.Cells(i, 2).Value = olMail.ReceivedTime
            ws.Cells(i, 3).Value = olMail.SenderName
            ws.Cells(i, 4).Value = olMail.Body
            i = i + 1
        End If
    Next olItem
    
    ' 释放对象，避免内存占用
    Set olMail = Nothing
    Set olItem = Nothing
    Set Fldr = Nothing
    Set olNs = Nothing
    Set olapp = Nothing
    
    MsgBox "邮件导入完成！"
End Sub

接下来是你要的按特定主题行或接收日期筛选的方法，分几种场景给你拆解：

1. 按特定主题行筛选 #

如果你要导入主题包含特定关键词（比如"项目进度"）的邮件，只需要在判断MailItem的基础上，再加一个主题条件判断：

' 替换循环内的判断部分
For Each olItem In Fldr.Items
    If TypeName(olItem) = "MailItem" Then
        Set olMail = olItem
        ' 筛选主题包含"项目进度"的邮件，去掉vbTextCompare会区分大小写
        If InStr(1, olMail.Subject, "项目进度", vbTextCompare) > 0 Then
            ws.Cells(i, 1).Value = olMail.Subject
            ws.Cells(i, 2).Value = olMail.ReceivedTime
            ws.Cells(i, 3).Value = olMail.SenderName
            ws.Cells(i, 4).Value = olMail.Body
            i = i + 1
        End If
    End If
Next olItem

如果需要精确匹配主题（完全一致），把InStr判断改成：

If olMail.Subject = "2024年Q3项目进度报告" Then

2. 按接收日期筛选 #

比如要导入近7天内的邮件，或者指定日期范围的邮件，代码调整如下：

场景A：导入近7天的邮件 #

' 替换循环内的判断部分
For Each olItem In Fldr.Items
    If TypeName(olItem) = "MailItem" Then
        Set olMail = olItem
        ' 判断接收时间是否在近7天内
        If olMail.ReceivedTime >= Date - 7 Then
            ws.Cells(i, 1).Value = olMail.Subject
            ws.Cells(i, 2).Value = olMail.ReceivedTime
            ws.Cells(i, 3).Value = olMail.SenderName
            ws.Cells(i, 4).Value = olMail.Body
            i = i + 1
        End If
    End If
Next olItem

场景B：导入指定日期范围的邮件（比如2024年9月1日-9月30日） #

' 替换循环内的判断部分
Dim startDate As Date, endDate As Date
startDate = DateSerial(2024, 9, 1)
endDate = DateSerial(2024, 9, 30)

For Each olItem In Fldr.Items
    If TypeName(olItem) = "MailItem" Then
        Set olMail = olItem
        ' 加#11:59:59 PM#是为了包含当天最后一秒的邮件，避免漏判
        If olMail.ReceivedTime >= startDate And olMail.ReceivedTime <= endDate + #11:59:59 PM# Then
            ws.Cells(i, 1).Value = olMail.Subject
            ws.Cells(i, 2).Value = olMail.ReceivedTime
            ws.Cells(i, 3).Value = olMail.SenderName
            ws.Cells(i, 4).Value = olMail.Body
            i = i + 1
        End If
    End If
Next olItem

3. 组合筛选（主题+日期） #

如果需要同时满足主题和日期条件，把两个判断合并即可：

For Each olItem In Fldr.Items
    If TypeName(olItem) = "MailItem" Then
        Set olMail = olItem
        ' 同时满足主题包含"项目进度"且是近7天的邮件
        If InStr(1, olMail.Subject, "项目进度", vbTextCompare) > 0 And olMail.ReceivedTime >= Date - 7 Then
            ws.Cells(i, 1).Value = olMail.Subject
            ws.Cells(i, 2).Value = olMail.ReceivedTime
            ws.Cells(i, 3).Value = olMail.SenderName
            ws.Cells(i, 4).Value = olMail.Body
            i = i + 1
        End If
    End If
Next olItem

最后提醒一句：运行代码前要确保Outlook已经打开，而且VBA编辑器里已经引用了「Microsoft Outlook xx.x Object Library」（在工具→引用里勾选对应版本）。

内容的提问来源于stack exchange，提问作者Akhil Chaudhary