outlook批量导出附件

Sub Save()
Dim olApp As New Outlook.Application
Dim nmsName As Outlook.NameSpace
Dim vItem As Object
Set nmsName = olApp.GetNamespace("MAPI")
Set myFolder = nmsName.GetDefaultFolder(olFolderInbox)
Set fldFolder = myFolder.Folders("Downloads")

For Each vItem In fldFolder.Items

For Each att In vItem.Attachments
att.SaveAsFile "C:\Downloads\" & att.FileName

Next

Next

Set fldFolder = Nothing
Set nmsName = Nothing
End Sub