|
上次提供了将“收件箱”里邮件导出至硬盘的代码。这次提供将邮件里的附件保存至硬盘的代码。
Sub Exprot_Mail_Attachments()
On Error Resume Next
Dim myolapp As New 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 "C:\电子邮件\" + IIf(IsNull(myAttachments.Item(1).DisplayName), i, myAttachments.Item(1).DisplayName)
End With
Next
End Sub |
|