为outlook增加“邮件召回”功能
outlook 2007开始软件自带邮件召回功能。2003版本没有，可惜此版本盗版最厉害，用户很广，这次项目中用户分布很广，其中outlook2003版本用户数甚多，达到397人。
不可能让他们新装2007/2010等，因此使用outlook2003“工具”菜单中的VBA宏编辑器进行开发
邮件召回的前提：
1、必须是exchange邮件
2、收件人必须是outlook客户端，OWA不支持
3、收件人必须未读邮件
Private WithEvents vsoCommbandButton As CommandBarButton
Private WithEvents vsoCommbandRecallMessage As CommandBarButton
Dim item As Object
Private Sub Application_Startup()
Call addTotalButton
End Sub
\’增加工具栏
Sub addTotalButton()
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）的执行
Private Sub 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
Sub ShowAttachmentDialog()
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