通过电子邮件地址将 Outlook 邮件项目移动到子文件夹
选项显式
公共子 Move_Items()
' // 声明你的变量
    将收件箱调暗为 Outlook.MAPIFolder
    将子文件夹变暗为 Outlook.MAPIFolder
    将 olN 变暗为 Outlook.NameSpace
    将项目暗淡为对象
    将项目调暗为 Outlook.Items
    Dim lngCount 一样长
    出错时转到 MsgErr
' 设置收件箱参考
    设置 olNs = Application.GetNamespace("MAPI")
    设置收件箱 = olNs.GetDefaultFolder(olFolderInbox)
    设置项目 = Inbox.Items
' // 向后循环遍历文件夹中的项目
    对于 lngCount = Items.Count 到 1 步 -1
        设置项目 = 项目（lngCount）
        如果Item.Class = olMail然后
            选择案例项目.SenderEmailAddress
' // Email_One
                Case "Email_One@email.com"
' // 设置收件箱的子文件夹
                    Set SubFolder = Inbox.Folders("文件夹一")
                    Set Item = Items.Find("[SenderEmailAddress] = 'Email_One@email.com'")
                    如果 TypeName(Item) <> "Nothing" 那么
' // 标记为已读
                        Item.UnRead = 假
' // 将邮件项移动到子文件夹
                        项目.移动子文件夹
                    结束如果
' // Email_Two
                Case "Email_Two@email.com"
' // 设置收件箱的子文件夹
                    Set SubFolder = Inbox.Folders("文件夹二")
                    Set Item = Items.Find("[SenderEmailAddress] = 'Email_Two@email.com'")
                    如果 TypeName(Item) <> "Nothing" 那么
' // 标记为已读
                        Item.UnRead = 假
' // 将邮件项移动到子文件夹
                        项目.移动子文件夹
                    结束如果
            最终选择
        结束如果
    下一个 lngCount
MsgErr_Exit：
    设置收件箱 = 无
    设置子文件夹 = 无
    设置 olNs = 无
    设置项目 = 无
    设置项目 = 无
    退出小组
'//错误信息
消息错误：
    MsgBox "发生了意外错误。" _
         & vbCrLf & "错误号：" & Err.Number _
         & vbCrLf & "错误描述：" & Err.Description _
         , vbCritical, "错误！"
    恢复 MsgErr_Exit
END SUB
或将所有邮件收件箱移动到子文件夹
选项显式
公共子 Move_Items()
' // 声明你的变量
    将收件箱调暗为 Outlook.MAPIFolder
    将子文件夹变暗为 Outlook.MAPIFolder
    将 olN 变暗为 Outlook.NameSpace
    将项目暗淡为对象
    Dim lngCount 一样长
    将项目调暗为 Outlook.Items
    出错时转到 MsgErr
' 设置收件箱参考
    设置 olNs = Application.GetNamespace("MAPI")
    设置收件箱 = olNs.GetDefaultFolder(olFolderInbox)
    设置项目 = Inbox.Items
' // 向后循环遍历文件夹中的项目
    对于 lngCount = Items.Count 到 1 步 -1
        设置项目 = 项目（lngCount）
        调试.打印项目.主题
        如果Item.Class = olMail然后
' // 设置收件箱的子文件夹
            设置子文件夹 = Inbox.Folders("Temp")
' // 标记为已读
            Item.UnRead = 假
' // 将邮件项移动到子文件夹
            项目.移动子文件夹
        结束如果
    下一个 lngCount
MsgErr_Exit：
    设置收件箱 = 无
    设置子文件夹 = 无
    设置 olNs = 无
    设置项目 = 无
    退出小组
'//错误信息
消息错误：
    MsgBox "发生了意外错误。" _
         & vbCrLf & "错误号：" & Err.Number _
         & vbCrLf & "错误描述：" & Err.Description _
         , vbCritical, "错误！"
    恢复 MsgErr_Exit
END SUB

试试下面提到的代码： -
子 MoveItems7TEST()

将 myNameSpace 调暗为 Outlook.NameSpace
将 myInbox 调暗为 Outlook.Folder
将 myInbox2 调暗为 Outlook.Folder
将 myInbox3 调暗为 Outlook.Folder

将 myDestFolder 调暗为 Outlook.Folder

将 myItems 调暗为 Outlook.Items
将 myItems2 调暗为 Outlook.Items
将 myItems3 调暗为 Outlook.Items

将 myItem 调暗为对象

设置 myNameSpace = Application.GetNamespace("MAPI")
'Posta in arrivo
设置 myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
'史蒂夫
设置 myInbox2 = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("Stef")
'服务
设置 myInbox3 = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("Servizio")

设置 myItems = myInbox.Items
设置 myItems2 = myInbox2.Items
设置 myItems3 = myInbox3.Items

设置 myDestFolder = myInbox.Folders("Da completare")

设置 myItem = myItems.Find("[FLAGSTATUS] = 8")
而 TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
设置 myItem = myItems.FindNext
蜿蜒

设置 myItem = myItems2.Find("[FLAGSTATUS] = 8")
而 TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
设置 myItem = myItems2.FindNext
蜿蜒

设置 myItem = myItems3.Find("[FLAGSTATUS] = 8")
而 TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
设置 myItem = myItems3.FindNext
蜿蜒
END SUB

希望这些信息对您有所帮助。