VBA从Outlook下载附件

Sub DownloadAttachmentsFromOutlook()
    Dim OutlookApp As Object
    Dim OutlookNamespace As Object
    Dim InboxFolder As Object
    Dim MailItem As Object
    Dim Attachment As Object
    Dim SaveFolder As String
    
    ' 设置保存附件的文件夹路径
    SaveFolder = "C:\Attachments"
    
    ' 连接到Outlook应用程序
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
    
    ' 获取收件箱文件夹
    Set InboxFolder = OutlookNamespace.GetDefaultFolder(6) ' 6表示收件箱
    
    ' 遍历每封邮件
    For Each MailItem In InboxFolder.Items
        ' 检查是否有附件
        If MailItem.Attachments.Count > 0 Then
            ' 遍历每个附件并保存到指定文件夹
            For Each Attachment In MailItem.Attachments
                Attachment.SaveAsFile SaveFolder & "\" & Attachment.FileName
            Next Attachment
        End If
    Next MailItem
    
    ' 释放对象
    Set InboxFolder = Nothing
    Set OutlookNamespace = Nothing
    Set OutlookApp = Nothing
    
    MsgBox "附件下载完成！"
End Sub