批量导出outlook中邮件的附件:

时间:2024-03-09 17:37:43

批量导出outlook中邮件的附件:

Public Sub SaveAtt()
Dim msg As MailItem
Dim exp As Explorer
Dim att As Attachment
Dim mailIndex As Integer
Dim path As String
Dim folder As String

Set exp = Application.ActiveExplorer

\'保存附件到哪个文件夹,末尾必须是斜杠
folder = "c:\temp\"
mailIndex = 0

For Each msg In exp.Selection

    If msg.Attachments.Count > 0 Then
        mailIndex = mailIndex + 1
        For Each att In msg.Attachments
            \'所有附件保存到folder指定的文件夹中,文件命名为:mailatt<编号>_附件原始文件名
            path = folder + "mailatt" + CStr(mailIndex) + "_" + att.FileName
            att.SaveAsFile path
        Next
    End If
    
Next

End Sub