Outlook宏编译错误：手动分类后移邮件至自定义搜索文件夹失败

问题分析 #

1. 混淆搜索文件夹与普通文件夹：搜索文件夹是虚拟视图，仅展示符合条件的邮件，不能存储实际邮件，无法通过Move方法将邮件移入。你实际需要的是创建普通自定义文件夹来存放邮件。
2. 错误的文件夹创建参数：Folders.Add方法不能用olSearchFolder作为类型参数创建普通文件夹，需使用对应邮件文件夹的类型常量。
3. 未处理多分类场景：直接判断objMail.Categories = "[01] Follow up"会遗漏同时拥有多个分类的邮件，需用字符串包含检查。
4. 遍历集合时修改集合导致遗漏：正向遍历Inbox.Items时移动邮件，会改变集合结构，导致部分邮件被跳过，需反向遍历。
5. 冗余变量：objCategory变量未被使用，可删除。

修正后的代码 #

Sub MoveFollowUpEmails()
    Dim objInbox As Outlook.MAPIFolder
    Dim objTargetFolder As Outlook.MAPIFolder
    Dim objMail As Outlook.MailItem
    Dim i As Integer
    
    ' 获取默认收件箱
    Set objInbox = Application.Session.GetDefaultFolder(olFolderInbox)
    
    ' 检查目标文件夹是否存在，不存在则创建
    On Error Resume Next
    Set objTargetFolder = objInbox.Parent.Folders("[01] Follow up")
    On Error GoTo 0 ' 恢复错误捕获
    
    If objTargetFolder Is Nothing Then
        ' 创建普通邮件文件夹
        Set objTargetFolder = objInbox.Parent.Folders.Add("[01] Follow up", olFolderMailItem)
    End If
    
    ' 反向遍历收件箱项目，避免移动后集合变动导致遗漏
    For i = objInbox.Items.Count To 1 Step -1
        ' 确保当前项目是邮件
        If TypeName(objInbox.Items(i)) = "MailItem" Then
            Set objMail = objInbox.Items(i)
            ' 检查邮件是否包含目标分类（不区分大小写）
            If InStr(1, objMail.Categories, "[01] Follow up", vbTextCompare) > 0 Then
                objMail.Move objTargetFolder
            End If
        End If
    Next i
    
    ' 释放对象
    Set objMail = Nothing
    Set objTargetFolder = Nothing
    Set objInbox = Nothing
End Sub

补充：如果需要创建搜索文件夹（仅展示分类邮件） #

若你确实需要虚拟的搜索文件夹（不移动邮件，仅展示符合条件的内容），可使用以下代码：

Sub CreateFollowUpSearchFolder()
    Dim objSearchRoot As Outlook.MAPIFolder
    Dim objSearchFolder As Outlook.SearchFolder
    
    Set objSearchRoot = Application.Session.GetDefaultFolder(olFolderSearchFolders)
    
    On Error Resume Next
    Set objSearchFolder = objSearchRoot.Folders("[01] Follow up")
    On Error GoTo 0
    
    If objSearchFolder Is Nothing Then
        ' 创建搜索文件夹，设置分类筛选条件
        Set objSearchFolder = objSearchRoot.Folders.Add("[01] Follow up", olSearchFolder)
        objSearchFolder.SearchCriteria.Filter = "@SQL=""urn:schemas-microsoft-com:office:office#Keywords"" LIKE '%[01] Follow up%'"
        objSearchFolder.Save
    End If
End Sub

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