求助：Outlook实现收件箱邮件移至同级自定义文件夹的VBA脚本

错误原因 #

你遇到的2147221233 (8004010f)错误，是因为代码错误地在收件箱的子文件夹中查找Reports，但实际Reports是和收件箱同级的自定义文件夹，因此无法定位到目标文件夹。

解决方案 #

要访问与默认文件夹同级的自定义文件夹，需先获取收件箱的父文件夹（即邮箱账户的根文件夹，包含收件箱、已发送邮件等默认文件夹及你创建的自定义文件夹），再从中定位Reports文件夹。

修改关键代码行 #

将原代码中获取目标文件夹的语句：

Set myDestFolder = myInbox.Folders("Reports")

替换为：

Set myDestFolder = myInbox.Parent.Folders("Reports")

完整修改后的代码 #

Sub MoveItems()
    Dim NewApp As Outlook.Application
    Dim myNameSpace As Outlook.Namespace
    Dim myInbox As Outlook.Folder
    Dim myDestFolder As Outlook.Folder
    Dim myItems As Outlook.Items
    Dim myItem As Object

    Set NewApp = New Outlook.Application
    Set myNameSpace = NewApp.GetNamespace("MAPI")
    Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
    Set myItems = myInbox.Items
    Set myItem = myItems.Find("[SenderName] = 'Kevin Feige'")

    ' 从收件箱的父文件夹（根文件夹）中获取同级的Reports文件夹
    Set myDestFolder = myInbox.Parent.Folders("Reports")

    While TypeName(myItem) <> "Nothing"
        myItem.Move myDestFolder
        Set myItem = myItems.FindNext
    Wend
End Sub

多账户场景补充 #

如果你的Outlook配置了多个邮箱账户，可通过指定账户名称精准定位：

' 替换为你的目标邮箱账户名称
Set myDestFolder = myNameSpace.Folders("your-email@domain.com").Folders("Reports")

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