如何自动导出附件中的多个附件?在论坛中下了以下宏,只能保存附件中的第一个,对一邮件含多个附件的如何处理?
Private Sub 保存附件()
On Error Resume Next
Dim myOlApp, myNameSpace, myfolder As Object
'Dim myolapp As Outlook.Application
Set myOlApp = CreateObject("outlook.application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myfolder = myNameSpace.GetDefaultFolder(olFolderInbox)
For i = 1 To myfolder.Items.Count
Set mymailitem = myfolder.Items(i)
With mymailitem
Set myAttachments = mymailitem.Attachments
myAttachments.Item(1).SaveAsFile "D:\人员库\" + IIf(IsNull(myAttachments.Item(1).DisplayName), i, myAttachments.Item(1).DisplayName)
End With
Next
End Sub
|