OutlookVBA开发第六讲-收回(Recall)刚发送的邮件
(如有问题，请联系dsd999@sohu.com)
说明：outlook已发邮件可以收回，前提是收件人还没有看这封邮件。
收回一封邮件，需要几个步骤，先到发件箱找到邮件，然后双击打开，再选择菜单中的收回，也许等这几步做完，收件人已经看了邮件。
下面列出的代码就是把上面的步骤放到一个按钮，只要点这个按钮，收回操作就完成了。
收回讲的就是要“快”。
Outlook版本：2003。
代码：
Private WithEvents vsoCommbandButton AsCommandBarButton
Private WithEvents vsoCommbandRecallMessageAs CommandBarButton
Dim item As Object
PrivateSub Application_Startup()
Call addTotalButton
End Sub
'增加工具栏
SubaddTotalButton()
On Error Resume Next
Dim vsoCommandBar As CommandBar
'得到要添加的工具栏
Set vsoCommandBar =Outlook.ActiveExplorer.CommandBars("ExcelClub")
'如果工具栏为空，则增加
If (vsoCommandBar Is Nothing) Then
Set vsoCommandBar =Outlook.ActiveExplorer.CommandBars.add("ExcelClub", msoBarTop)
'在工具栏上增加一个按钮
Set vsoCommbandRecallMessage =vsoCommandBar.Controls.add(1)
vsoCommbandRecallMessage.Caption = "RecallMail"
vsoCommbandRecallMessage.FaceId = 72
vsoCommbandRecallMessage.Style =msoButtonIconAndCaption
'显示增加的工具栏
vsoCommandBar.Visible = True
Else
Set vsoCommbandRecallMessage =vsoCommandBar.Controls(1)
End If
End Sub
'增加的按钮（RecallMail）的执行
PrivateSub vsoCommbandRecallMessage_Click(ByVal Ctrl As Office.CommandBarButton,CancelDefault As Boolean)
'出现错误时下一句代码继续运行
On Error Resume Next
Dim objNS As Outlook.NameSpace
Dim myItem As Outlook.mailItem,objSendFolder As Outlook.MAPIFolder
Dim objItems As Outlook.Items
Dim tmpItem As Object
Set objNS =Application.GetNamespace("MAPI")
Set objSendFolder =objNS.GetDefaultFolder(olFolderSentMail)
Set objItems = objSendFolder.Items
objItems.Sort "[SentOn]", True
Set tmpItem = objItems.GetFirst
Do While TypeName(tmpItem) <>"Nothing"
If TypeName(tmpItem) = "MailItem" Then
Set myItem = tmpItem
Exit Do
End If
Set tmpItem = objItems.GetNext
Loop
Set item = myItem
item.Display
Call ShowAttachmentDialog
myItem.Close olDiscard
End Sub
SubShowAttachmentDialog()
Dim objInsp
Dim colCB
Dim objCBB
On Error Resume Next
Set objInsp = item.GetInspector
Set colCB = objInsp.CommandBars
Set objCBB = colCB.FindControl(, 2511)
If Not objCBB Is Nothing Then
SendKeys "{ENTER}", wait
objCBB.Execute
End If
Set objCBB = Nothing
Set colCB = Nothing
Set objInsp = Nothing
End Sub
