拼车信息请发到 /go/cosub 节点。 如果没有发送到 /go/cosub,那么会被移动到 /go/pointless。如果持续触发这样的移动,会导致账号被禁用。
swlaw

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

  •  
  •   swlaw · May 7, 2019 · 5275 views
    This topic created in 2566 days ago, the information mentioned may be changed or developed.
    各位先进你们好。
    近期为公司领导设置了 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 replies    2019-08-19 16:12:53 +08:00
    intuitionfly
        1
    intuitionfly  
       Aug 19, 2019
    可以用。我用的 outlook 2010,把宏设置成一个按钮,选中收件箱中任意一个邮件,运行宏就行了。
    About   ·   Help   ·   Advertise   ·   Blog   ·   API   ·   FAQ   ·   Solana   ·   2932 Online   Highest 6679   ·     Select Language
    创意工作者们的社区
    World is powered by solitude
    VERSION: 3.9.8.5 · 401ms · UTC 10:12 · PVG 18:12 · LAX 03:12 · JFK 06:12
    ♥ Do have faith in what you're doing.