|
Компьютерный форум OSzone.net » Сфера Microsoft » Microsoft Office (Word, Excel, Outlook и т.д.) » 2010 - Outlook удалить дубликаты сообщений |
|
|
2010 - Outlook удалить дубликаты сообщений
|
Пользователь Сообщения: 125 |
Профиль | Отправить PM | Цитировать Привет Всем.
Ребят, подскажите рабочий плагин для outlook 2010 без ограничения, в ящике более 1000 писем и удалять по 5-10 не вариант. Нужно навести порядок за 3 года активного использования почты. |
|
Отправлено: 14:21, 07-09-2018 |
Динохромный Сообщения: 690
|
Профиль | Отправить PM | Цитировать Beliy.IV, попробуйте код отсюда.
Тестировал на Outlook 2013, код отработал корректно. Необходимо предварительно создать файл "c:\temp\deleted msg.csv". Код
Const strPath = "c:\temp\deleted msg.csv" Sub DeleteDuplicateEmails() Dim lngCnt As Long Dim objMail As Object Dim objFSO As Object Dim objTF As Object Dim objDic As Object Dim objItem As Object Dim olApp As Outlook.Application Dim olNS As NameSpace Dim olFolder As Folder Dim olFolder2 As Folder Dim strCheck As String Set objDic = CreateObject("scripting.dictionary") Set objFSO = CreateObject("scripting.filesystemobject") Set objTF = objFSO.CreateTextFile(strPath) objTF.WriteLine "Subject" Set olApp = Outlook.Application Set olNS = olApp.GetNamespace("MAPI") Set olFolder = olNS.PickFolder If olFolder Is Nothing Then Exit Sub On Error Resume Next Set olFolder2 = olFolder.Folders("removed items") On Error GoTo 0 If olFolder2 Is Nothing Then Set olFolder2 = olFolder.Folders.Add("removed items") For lngCnt = olFolder.Items.Count To 1 Step -1 Set objItem = olFolder.Items(lngCnt) strCheck = objItem.Subject & "," & objItem.Body & "," strCheck = Replace(strCheck, ", ", Chr(32)) If objDic.Exists(strCheck) Then objItem.Move olFolder2 objTF.WriteLine Replace(objItem.Subject, ", ", Chr(32)) Else objDic.Add strCheck, True End If Next If objTF.Line > 2 Then MsgBox "duplicate items were removed to ""removed items""", vbCritical, "See " & strPath & " for details" Else MsgBox "No duplicates found" End If End Sub |
------- Отправлено: 09:20, 08-09-2018 | #2 |
Для отключения данного рекламного блока вам необходимо зарегистрироваться или войти с учетной записью социальной сети. Если же вы забыли свой пароль на форуме, то воспользуйтесь данной ссылкой для восстановления пароля. |
Ушел из жизни Сообщения: 8595
|
Профиль | Сайт | Отправить PM | Цитировать Beliy.IV, поищите ODIR
|
Отправлено: 16:45, 08-09-2018 | #3 |
Пользователь Сообщения: 125
|
Профиль | Отправить PM | Цитировать Цитата mwz:
Цитата a_axe:
|
||
Последний раз редактировалось Beliy.IV, 10-09-2018 в 10:10. Отправлено: 09:28, 10-09-2018 | #4 |
Пользователь Сообщения: 125
|
Профиль | Отправить PM | Цитировать Не, чёт не пойму вот у меня 5к сообщений, он мне перемещает 3,5к в removed items, я смотрю туда и пытаюсь найти такие же в входящих - нет таких
т.е. в период с 12 до 13 у меня в входящих 1 сообщение, а в removed items 6 писем ( есть повторяющиеся ), объсните как пользоваться. Ещё при большом кол-ве писем выскакивает ошибка |
|
Последний раз редактировалось Beliy.IV, 10-09-2018 в 15:46. Отправлено: 15:34, 10-09-2018 | #5 |
Динохромный Сообщения: 690
|
Профиль | Отправить PM | Цитировать Цитата Beliy.IV:
Можно сравнивать например также по email отправителя и времени отправки письма: Код
Const strPath = "c:\temp\deleted msg.csv" Sub DeleteDuplicateEmails_2() Dim lngCnt As Long Dim objMail As Object Dim objFSO As Object Dim objTF As Object Dim objDic As Object Dim objItem As Object Dim olApp As Outlook.Application Dim olNS As NameSpace Dim olFolder As Folder Dim olFolder2 As Folder Dim strCheck As String Set objDic = CreateObject("scripting.dictionary") Set objFSO = CreateObject("scripting.filesystemobject") Set objTF = objFSO.CreateTextFile(strPath) objTF.WriteLine "Subject" Set olApp = Outlook.Application Set olNS = olApp.GetNamespace("MAPI") Set olFolder = olNS.PickFolder If olFolder Is Nothing Then Exit Sub On Error Resume Next Set olFolder2 = olFolder.Folders("removed items") On Error GoTo 0 If olFolder2 Is Nothing Then Set olFolder2 = olFolder.Folders.Add("removed items") For lngCnt = olFolder.Items.Count To 1 Step -1 Set objItem = olFolder.Items(lngCnt) strCheck = objItem.Subject & "," & objItem.Body & "," & objItem.SenderEmailAddress & "," & objItem.SentOn & "," strCheck = Replace(strCheck, ", ", Chr(32)) If objDic.Exists(strCheck) Then objItem.Move olFolder2 objTF.WriteLine Replace(objItem.Subject, ", ", Chr(32)) Else objDic.Add strCheck, True End If Next If objTF.Line > 2 Then MsgBox "duplicate items were removed to ""removed items""", vbCritical, "See " & strPath & " for details" Else MsgBox "No duplicates found" End If End Sub Попробуйте, отпишитесь по результатам. |
|
------- Последний раз редактировалось a_axe, 10-09-2018 в 21:08. Причина: Подправил код. Отправлено: 20:49, 10-09-2018 | #6 |
Пользователь Сообщения: 125
|
Профиль | Отправить PM | Цитировать Попробовал теперь ошибка выскакивает постоянно и процесс не завершается, т.е. не одного письме не отбирает. Ошибка ссылается на
Правильно ли я понимаю, что этот код это module, файл я создаю пустой
|
Отправлено: 08:38, 11-09-2018 | #7 |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать Цитата Beliy.IV:
|
|
Отправлено: 21:09, 11-09-2018 | #8 |
Пользователь Сообщения: 125
|
Профиль | Отправить PM | Цитировать Цитата Iska:
|
|
Отправлено: 08:20, 12-09-2018 | #9 |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать «Объект не поддерживает данное свойство или метод». Становитесь в режиме отладки и смотрите на objItem и на каждый objItem.bla-bla-bla в этой строке, чего и у кого там нет.
|
Отправлено: 17:18, 12-09-2018 | #10 |
|
Участник сейчас на форуме | Участник вне форума | Автор темы | Сообщение прикреплено |
| |||||
Название темы | Автор | Информация о форуме | Ответов | Последнее сообщение | |
Любой язык - [решено] Удалить дубликаты домена | Alexander_88 | Скриптовые языки администрирования Windows | 4 | 19-07-2018 05:36 | |
2016 - Отображения сообщений в Outlook | ZMozzi | Microsoft Office (Word, Excel, Outlook и т.д.) | 1 | 28-02-2017 13:10 | |
2007 - формат сообщений outlook 2007 | Outstanding | Microsoft Office (Word, Excel, Outlook и т.д.) | 2 | 17-02-2014 19:42 | |
Прочие - Нужно удалить дубликаты контактов | dionisys | Программное обеспечение Windows | 3 | 20-09-2012 14:03 | |
Клиенты - Проблемы с кодировкой сообщений во время импорта в Outlook Express 6.0 из MS Outlook | storm29 | Microsoft Exchange Server | 3 | 16-12-2010 11:39 |
|