V2EX = way to explore
V2EX 是一个关于分享和探索的地方
现在注册
已注册用户请  登录
拼车信息请发到 /go/cosub 节点。 如果没有发送到 /go/cosub,那么会被移动到 /go/pointless。如果持续触发这样的移动,会导致账号被禁用。
swlaw
V2EX  ›  Microsoft Office

请教 outlook2016 去除重复邮件的方法

  •  
  •   swlaw · 2019-05-07 09:18:22 +08:00 · 4808 次点击
    这是一个创建于 2035 天前的主题,其中的信息可能已经有所发展或是发生改变。
    各位先进你们好。
    近期为公司领导设置了 outlook2016 收发公司自己建的邮箱,设置成 POP3。现在一台 PC 要重装,备份了 PST。重装完成,打开该 PST,并重新设置 outlook。邮箱不断收取重复的邮件(备份的 PST 有一份,再次收取一次)。

    由于邮件很多,超过 3000 份,要逐一排除很困难。网上查找了很多资料,包括微软的官方技术论坛,都简单地建议下载“ outlook-duplicates-remover ”使用。可改软件需要注册,较旧的版本对中文支持也不好,邮件标题乱码。

    在多次查找有,在 EXCELHOME 论坛查到以下 VB 代码:



    Sub DelDuplicateMail() '删除重复邮件
    Dim olApp As Outlook.Application
    Dim fld_Inbox As Outlook.Folder
    Dim objItems As Outlook.Items
    Dim myItem As Object
    Dim dupItem As Object
    Dim i%, j%
    Dim ThisSenderEmailAddress, NextSenderEmailAddress As String
    Dim ThisSize, NextSize As Long
    Dim ThisSentOn, NextSentOn As Date
    Dim ThisBody, NextBody As String
    Dim st As Object

    aa = Timer
    Set olApp = Outlook.Application

    For Each st In Application.ActiveExplorer.Selection '选择当前邮件对应的文件夹
    If TypeName(st) = "MailItem" Then
    Set fld_Inbox = st.Parent
    Exit For
    End If
    Next

    If TypeName(fld_Inbox) <> "MAPIFolder" Then MsgBox "请选择有效文件夹,程序退出": Exit Sub
    Set objItems = fld_Inbox.Items
    If objItems.Count = 1 Then MsgBox "请选择大于 1 封邮件的文件夹,程序退出": Exit Sub

    'Set objItems = objItems.Restrict("[SentOn] > '8/1/2014'"
    objItems.Sort "[SentOn]", True '按日期排序

    i = 0
    For j = objItems.Count To 2 Step -1
    Set myItem = objItems(j)
    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(j - 1)
    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
    End If
    End If
    End If
    Next

    MsgBox "共删除" & i & "封邮件。运行时间为" & Format(Timer - aa, "0.00") & "秒"
    End Sub

    我按照说明,将其加入 outlook 开发工具那里,全选邮件后点击运行,并无作用。而 excelhome 该帖子是没有回复的,不知该代码是否真的能用?
    还请各位不吝赐教。谢谢。
    1 条回复    2019-08-19 16:12:53 +08:00
    intuitionfly
        1
    intuitionfly  
       2019-08-19 16:12:53 +08:00
    可以用。我用的 outlook 2010,把宏设置成一个按钮,选中收件箱中任意一个邮件,运行宏就行了。
    关于   ·   帮助文档   ·   博客   ·   API   ·   FAQ   ·   实用小工具   ·   2480 人在线   最高记录 6679   ·     Select Language
    创意工作者们的社区
    World is powered by solitude
    VERSION: 3.9.8.5 · 25ms · UTC 02:33 · PVG 10:33 · LAX 18:33 · JFK 21:33
    Developed with CodeLauncher
    ♥ Do have faith in what you're doing.