OUTLOOK自动删除重复邮件脚本
2015-08-28 10:00
405 查看
OUTLOOK自动删除重复邮件脚本
Sub DeleteMail() 'outLook2007版本验证!使用前请调低宏安全性 Dim olApp As New Outlook.Application Dim fld_Inbox As Outlook.Folder Dim objItems As Outlook.Items Dim myItem As Object Dim dupItem As Object Dim i As Long Dim ThisSenderEmailAddress, NextSenderEmailAddress As String Dim ThisSize, NextSize As Long Dim ThisSentOn, NextSentOn As Date Dim ThisBody, NextBody As String Set fld_Inbox = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) Set objItems = fld_Inbox.Items '按发信时间过滤邮件列表, 'Set objItems = objItems.Restrict("[SentOn] > '8/1/2014'") objItems.Sort "[SentOn]", True Set myItem = objItems.GetFirst i = 0 Do While TypeName(myItem) <> "Nothing" If TypeName(myItem) = "MailItem" Then ThisSenderEmailAddress = myItem.SenderEmailAddress '发件人邮箱 ThisSize = myItem.Size '邮件大小 ThisSentOn = myItem.SentOn '发信时间,如"2015/8/28 9:57:02" ThisBody = myItem.Body '邮件文本内容 Set dupItem = objItems.GetNext If TypeName(dupItem) = "MailItem" Then NextSenderEmailAddress = dupItem.SenderEmailAddress NextSize = dupItem.Size NextSentOn = dupItem.SentOn NextBody = dupItem.Body '删除发件人、发信时间和邮件内容完全相同的邮件 If ThisSenderEmailAddress = NextSenderEmailAddress And ThisSentOn = NextSentOn And ThisBody = NextBody Then dupItem.Delete i = i + 1 Else Set myItem = dupItem End If Else Set myItem = dupItem End If Else Set myItem = objItems.GetNext End If Loop End Sub
相关文章推荐
- UIPickerView 地区解析 -- 全国省、市、区 plist 解析 -- 读取UIPickerView 当前显示内容
- 总结,PS里最常见的快捷键!
- 移动端屏幕适配方案
- Webservice-Java-CXF
- Webservice-Java-Xfire
- TCP三次握手及其背后的缺陷
- struts2 拦截器学习笔记01
- linux中waitpid系统调用
- Eclipse打JAR包,插件FatJar安装与使用
- getopt_long函数解析命令行参数
- java动态代理详解
- Apriori算法的java实现
- jstree父节点与子节点操作互不影响
- PHP在linux上执行外部命令(整理)
- Java线程
- 关于黑名单IP的设置
- 解析软件设计中那些最基础的控件使
- maven 工程 dubbo服务的xml配置文件报错的问题
- 人际关系之三纲五常
- C++浮点型输出保留小数位