Outlook VBA开发保存选中邮件的所有附件到一个目录中

Outlook VBA开发第二讲-保存选中邮件的所有附件到一个目录中

(如有问题，请联系dsd999@https://www.360docs.net/doc/f015805333.html,)

需求：添加按钮，保存选中邮件的所有附件到一个目录中。

代码：

Private WithEvents vsoCommbandSaveAttach As CommandBarButton

Private Sub Application_Startup()

Call addTotalButton

End Sub

增加工具栏

Sub addTotalButton()

On Error Resume Next

Dim vsoCommandBar As CommandBar

‘得到要添加的工具栏

Set vsoCommandBar = https://www.360docs.net/doc/f015805333.html,mandBars("ExcelClub")

‘如果工具栏为空，则增加

If (vsoCommandBar Is Nothing) Then

Set vsoCommandBar = https://www.360docs.net/doc/f015805333.html,mandBars.add("ExcelClub", msoBarTop)

‘在工具栏上增加一个按钮

Set vsoCommbandSaveAttach = vsoCommandBar.Controls.add(1) vsoCommbandSaveAttach.Caption = "Save Attachment" vsoCommbandSaveAttach.FaceId = 66

vsoCommbandSaveAttach.Style = msoButtonIconAndCaption

‘显示增加的工具栏

vsoCommandBar.Visible = True

Else

Set vsoCommbandSaveAttach = vsoCommandBar.Controls(1)

End If

End Sub

‘增加的按钮（Save Attachment）的执行

Private Sub vsoCommbandSaveAttach_Click(ByVal Ctrl As https://www.360docs.net/doc/f015805333.html,mandBarButton, CancelDefault As Boolean)

‘出现错误时下一句代码继续运行

On Error Resume Next

Dim objItem As Outlook.MailItem

Dim Attachment As Outlook.Attachment

‘遍历所有选中的项

For Each objItem In Application.ActiveExplorer.Selection

‘如果选中的是邮件

If objItem.Class = olMail Then

‘遍历邮件中的所有附件

For Each Attachment In objItem.Attachments

‘将附件保存在c盘根目录下

Attachment.SaveAsFile "c:\" & Attachment.FileName

Next

End If

Next

MsgBox "附件保存在c盘根目录下"

End Sub

结果如图