为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
轉載于:https://www.cnblogs.com/jiangu66/p/3206679.html
總結
以上是生活随笔為你收集整理的为outlook增加“邮件召回”功能的全部內容,希望文章能夠幫你解決所遇到的問題。
- 上一篇: Apache URL重写的配置 及其 a
- 下一篇: 飞思卡尔总结