如何在Outlook VBA中实现邮件移动至多级子文件夹？

你当前代码的问题出在objNS.GetDefaultFolder(olFolderInbox).Folders("Agresso/Sent")这一行——Outlook的Folders集合只能识别当前文件夹下的直接子文件夹名称，没法解析带斜杠的嵌套路径，所以找不到目标子文件夹。

下面提供两种解决方法：

方法一：逐层获取子文件夹（适合层级较少的情况） #

直接逐层访问嵌套文件夹，先找到收件箱下的"Agresso"，再从该文件夹下获取"Sent"子文件夹：

Option Explicit

Sub MoveOpenMessage()
 
    Dim objNS As Outlook.NameSpace
    Dim objInbox As Outlook.MAPIFolder
    Dim objAgressoFolder As Outlook.MAPIFolder
    Dim objDestFolder As Outlook.MAPIFolder
    Dim objItem As Outlook.MailItem
    
    Set objNS = Application.GetNamespace("MAPI")
    Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
    
    ' 逐层获取嵌套子文件夹
    On Error Resume Next ' 防止文件夹不存在时报错
    Set objAgressoFolder = objInbox.Folders("Agresso")
    Set objDestFolder = objAgressoFolder.Folders("Sent")
    On Error GoTo 0
    
    ' 检查目标文件夹是否存在
    If objDestFolder Is Nothing Then
        MsgBox "目标文件夹不存在，请检查路径！", vbExclamation
        GoTo Cleanup
    End If
      
    ' 获取选中的邮件
    Set objItem = Application.ActiveExplorer.Selection.Item(1)
 
    ' 移动邮件
    objItem.Move objDestFolder
        
Cleanup:
    Set objDestFolder = Nothing
    Set objAgressoFolder = Nothing
    Set objInbox = Nothing
    Set objNS = Nothing
End Sub

方法二：递归函数查找深层子文件夹（适合多层嵌套场景） #

如果需要支持更深的层级（比如"Agresso/Sent/2024/June"），可以用递归函数批量解析路径，灵活性更高：

Option Explicit

Sub MoveOpenMessageToDeepFolder()
 
    Dim objNS As Outlook.NameSpace
    Dim objInbox As Outlook.MAPIFolder
    Dim objDestFolder As Outlook.MAPIFolder
    Dim objItem As Outlook.MailItem
    Dim targetPath As String
    
    ' 定义目标嵌套路径，用斜杠分隔各层级
    targetPath = "Agresso/Sent"
    
    Set objNS = Application.GetNamespace("MAPI")
    Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
    
    ' 调用自定义函数查找目标文件夹
    Set objDestFolder = GetNestedFolder(objInbox, targetPath)
    
    If objDestFolder Is Nothing Then
        MsgBox "目标文件夹不存在，请检查路径！", vbExclamation
        GoTo Cleanup
    End If
      
    Set objItem = Application.ActiveExplorer.Selection.Item(1)
    objItem.Move objDestFolder
        
Cleanup:
    Set objDestFolder = Nothing
    Set objInbox = Nothing
    Set objNS = Nothing
End Sub

' 递归查找嵌套文件夹的工具函数
Function GetNestedFolder(parentFolder As Outlook.MAPIFolder, folderPath As String) As Outlook.MAPIFolder
    Dim folderNames() As String
    Dim currentFolder As Outlook.MAPIFolder
    Dim i As Integer
    
    ' 按斜杠拆分路径为层级数组
    folderNames = Split(folderPath, "/")
    Set currentFolder = parentFolder
    
    On Error Resume Next
    ' 逐层查找文件夹
    For i = LBound(folderNames) To UBound(folderNames)
        Set currentFolder = currentFolder.Folders(folderNames(i))
        If currentFolder Is Nothing Then Exit For ' 某一层不存在，直接退出
    Next i
    On Error GoTo 0
    
    Set GetNestedFolder = currentFolder
End Function

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