通过Excel实现Outlook邮件在自定义文件夹间迁移的代码修改需求

以下是适配你需求的修改后代码，可实现从收件箱同级的TestA文件夹批量移动所有邮件到TestB文件夹：

Sub MoveItemsFromTestAToTestB()
    Dim outlookApp As Object
    Dim myNameSpace As Object
    Dim rootFolder As Object ' 对应收件箱的同级根文件夹
    Dim sourceFolder As Object ' TestA文件夹
    Dim destFolder As Object ' TestB文件夹
    Dim myItems As Object
    Dim i As Integer
    
    ' 后期绑定Outlook，无需提前引用对象库
    Set outlookApp = CreateObject("Outlook.Application")
    Set myNameSpace = outlookApp.GetNamespace("MAPI")
    ' 获取收件箱的父文件夹（即邮箱根目录，TestA/TestB与收件箱同级）
    Set rootFolder = myNameSpace.GetDefaultFolder(6).Parent ' 6对应olFolderInbox的枚举值
    ' 获取源文件夹TestA和目标文件夹TestB
    Set sourceFolder = rootFolder.Folders("TestA")
    Set destFolder = rootFolder.Folders("TestB")
    
    Set myItems = sourceFolder.Items
    ' 倒序遍历，避免移动邮件后集合索引错乱
    For i = myItems.Count To 1 Step -1
        myItems.Item(i).Move destFolder
    Next i
    
    ' 释放对象
    Set myItems = Nothing
    Set destFolder = Nothing
    Set sourceFolder = Nothing
    Set rootFolder = Nothing
    Set myNameSpace = Nothing
    Set outlookApp = Nothing
    
    MsgBox "邮件移动完成！", vbInformation
End Sub

关键修改说明： #

• 文件夹定位：原代码基于收件箱子文件夹，现在通过GetDefaultFolder(6).Parent获取收件箱的父级根文件夹，直接定位到与收件箱同级的TestA和TestB
• 后期绑定：使用CreateObject创建Outlook实例，无需在VBA编辑器中提前引用Outlook对象库，兼容性更好
• 对象释放：添加对象释放代码，避免内存泄漏
• 倒序遍历保留：保持原代码的倒序遍历逻辑，因为移动邮件会改变Items集合的索引，正序遍历会导致部分邮件被跳过

使用注意事项： #

• 确保Outlook已打开，且TestA和TestB文件夹确实存在于邮箱根目录（与收件箱同级）
• 如果是Exchange账户，根文件夹层级若有差异，可通过Outlook的文件夹路径确认调整

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