为outlook增加“邮件召回”功能
来源:互联网 发布:dreamweaver做淘宝分类 编辑:程序博客网 时间:2024/04/30 01:44
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
不可能让他们新装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
- 为outlook增加“邮件召回”功能
- outlook 召回邮件 (zz)
- 为Outlook增加SolutionsModule
- Pinger为iOS版textfree增加语音邮件功能
- 邮件服务器DKIM添加 为Postfix增加DKIM功能
- 如何为extmail增加邮件短信通知功能
- outlook Express 邮件自动回复功能
- discuz增加邮件通知功能
- Outlook 2007 答复邮件中不能使用插入图片功能
- Outlook 如何打开或关闭邮件预览功能
- 使用outlook快速步骤功能提高邮件处理效率
- 通过编程为Outlook 2007添加邮件规则
- outlook 2007 帐户为Exchange时更改邮件存储路径
- 使用Outlook插件实现自动保存邮件为TestTrack记录
- 使用Outlook插件实现自动保存邮件为TestTrack记录
- 为myeclipse增加反编译功能
- outlook express 邮件导入 outlook
- CA证书应用一:Outlook发送邮件时,为邮件添加数字签名
- DataGridView查询数据
- 普利姆算法
- Web内部控件DropDownList
- HDU 1004 Let the Balloon Rise
- glTexCoord2f
- 为outlook增加“邮件召回”功能
- 大学该怎么读?
- C#中 如何执行带GO的sql 语句
- Oracle常用收集
- 深入理解Linux之copy_process()
- JS 实现图片直接下载
- POJ 3664
- 【数据挖掘】文档分类之朴素贝叶斯算法
- Java 线程间的通信