使用Excel VBA将Outlook已发送邮件复制到Windows文件夹

Sub CopySentEmails()
    Dim olApp As Object
    Dim olNamespace As Object
    Dim olFolder As Object
    Dim olItems As Object
    Dim olMail As Object
    Dim saveFolder As String
    
    ' 设置保存邮件的文件夹路径
    saveFolder = "C:\Path\To\Save\Folder\"
    
    ' 创建Outlook应用对象
    Set olApp = CreateObject("Outlook.Application")
    ' 获取Outlook命名空间
    Set olNamespace = olApp.GetNamespace("MAPI")
    ' 获取已发送邮件文件夹
    Set olFolder = olNamespace.GetDefaultFolder(5)
    ' 获取已发送邮件列表
    Set olItems = olFolder.Items
    
    ' 遍历已发送邮件列表
    For Each olMail In olItems
        ' 判断邮件是否已读
        If olMail.UnRead = False Then
            ' 保存邮件到指定文件夹
            olMail.SaveAs saveFolder & olMail.Subject & ".msg"
        End If
    Next olMail
    
    ' 释放对象
    Set olItems = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
    
    MsgBox "已将已发送邮件复制到指定文件夹。"
End Sub