如何用VBA代码将Outlook已发送邮件中含Drive 20-Feb-23的移至其他文件夹？

以下是可实现需求的VBA代码，直接在Outlook中运行即可：

Sub MoveTargetSentEmails()
    Dim objNamespace As Outlook.NameSpace
    Dim objSentFolder As Outlook.Folder
    Dim objTargetFolder As Outlook.Folder
    Dim objMail As Outlook.MailItem
    Dim strSearchSubject As String
    Dim colItems As Outlook.Items
    Dim i As Integer
    
    ' 设置要匹配的主题关键词
    strSearchSubject = "Drive 20-Feb-23"
    
    ' 获取Outlook命名空间
    Set objNamespace = Application.GetNamespace("MAPI")
    
    ' 定位到已发送邮件文件夹
    Set objSentFolder = objNamespace.GetDefaultFolder(olFolderSentMail)
    
    ' 替换为你的目标文件夹路径（例："收件箱\项目归档\Drive月度备份"）
    On Error Resume Next
    Set objTargetFolder = objNamespace.Folders("你的邮箱账号").Folders("收件箱").Folders("目标文件夹名")
    On Error GoTo 0
    
    ' 检查目标文件夹是否存在
    If objTargetFolder Is Nothing Then
        MsgBox "目标文件夹不存在，请确认路径是否正确！", vbExclamation
        Exit Sub
    End If
    
    ' 获取已发送文件夹中的所有邮件，倒序遍历避免索引混乱
    Set colItems = objSentFolder.Items
    colItems.Sort "[ReceivedTime]", olDescending
    
    ' 遍历邮件并移动符合条件的项
    For i = colItems.Count To 1 Step -1
        If TypeName(colItems(i)) = "MailItem" Then
            Set objMail = colItems(i)
            ' 匹配主题（不区分大小写，如需区分则去掉LCase）
            If InStr(LCase(objMail.Subject), LCase(strSearchSubject)) > 0 Then
                objMail.Move objTargetFolder
            End If
        End If
    Next i
    
    MsgBox "完成！已移动所有符合条件的邮件。", vbInformation
    
    ' 释放对象
    Set objMail = Nothing
    Set colItems = Nothing
    Set objTargetFolder = Nothing
    Set objSentFolder = Nothing
    Set objNamespace = Nothing
End Sub

使用说明 #

• 修改目标文件夹路径：找到代码中Set objTargetFolder = ...这一行，替换成你实际的文件夹层级结构，比如你的邮箱账号是xxx@domain.com，目标文件夹在"归档"下的"Drive备份"，就写成objNamespace.Folders("xxx@domain.com").Folders("归档").Folders("Drive备份")
• 区分大小写匹配：如果需要严格区分主题的大小写，把InStr(LCase(objMail.Subject), LCase(strSearchSubject)) > 0改成InStr(objMail.Subject, strSearchSubject) > 0
• 运行代码：打开Outlook，按下Alt + F11打开VBA编辑器，右键点击左侧项目窗格中的Project1，选择「插入」→「模块」，将代码粘贴进去，按下F5运行即可

注意事项 #

• 运行前建议先备份已发送邮件，避免意外操作导致数据丢失
• 如果已发送邮件数量较多，遍历过程可能需要几分钟，请耐心等待
• 若代码运行报错，优先检查目标文件夹路径是否正确，以及是否有足够的权限访问该文件夹

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