VBA从Outlook下载附件

Sub DownloadAttachments()
    Dim olApp As Outlook.Application
    Dim olNs As Outlook.Namespace
    Dim olFolder As Outlook.Folder
    Dim olMail As Outlook.MailItem
    Dim olAttach As Outlook.Attachment
    Dim i As Integer
    
    ' 创建Outlook应用程序对象
    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    
    ' 设置要遍历的文件夹（例如：收件箱）
    Set olFolder = olNs.GetDefaultFolder(olFolderInbox)
    
    ' 遍历文件夹中的所有邮件
    For Each olMail In olFolder.Items
        ' 检查邮件是否有附件
        If olMail.Attachments.Count > 0 Then
            ' 遍历邮件中的所有附件
            For Each olAttach In olMail.Attachments
                ' 设置附件保存路径（根据需要修改）
                olAttach.SaveAsFile "C:\Attachments\" & olAttach.FileName
            Next olAttach
        End If
    Next olMail
    
    ' 释放对象变量
    Set olAttach = Nothing
    Set olMail = Nothing
    Set olFolder = Nothing
    Set olNs = Nothing
    Set olApp = Nothing
    
    MsgBox "附件下载完成！"
End Sub