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
结果如图