使用VBA将多个Outlook电子邮件保存到驱动器

Sub SaveEmailsToDrive()
    Dim objNamespace As Outlook.Namespace
    Dim objFolder As Outlook.Folder
    Dim objMail As Outlook.MailItem
    Dim objAttachment As Outlook.Attachment
    Dim saveFolder As String
    
    ' 设置保存路径
    saveFolder = "C:\Emails"
    
    ' 获取Outlook应用程序的命名空间
    Set objNamespace = Outlook.Application.GetNamespace("MAPI")
    
    ' 获取收件箱文件夹
    Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)
    
    ' 遍历收件箱中的所有邮件
    For Each objMail In objFolder.Items
        ' 检查邮件是否有附件
        If objMail.Attachments.Count > 0 Then
            ' 遍历邮件的所有附件
            For Each objAttachment In objMail.Attachments
                ' 保存附件到指定路径
                objAttachment.SaveAsFile saveFolder & "\" & objAttachment.FileName
            Next objAttachment
        End If
    Next objMail
    
    ' 释放对象
    Set objAttachment = Nothing
    Set objMail = Nothing
    Set objFolder = Nothing
    Set objNamespace = Nothing
    
    MsgBox "邮件保存完成！"
End Sub