Поиск электронной почты Outlook (и ответа на него) с помощью Excel VBA


1

Я хочу искать ВСЕ мой прогноз на последнее сообщение в разговоре (я использую имя Subject в качестве ключа поиска).

Это последнее сообщение может быть в папке «Входящие», «Отправленные», в подпапке «Входящие», вложенной папке «Входящие» (в любом месте).

Я могу достичь этого с помощью очень утомительного кода, проходящего через каждый уровень каждой основной папки, но не только этот метод очень грязный, я не могу определить, является ли это найденное сообщение последним в этом разговоре.

Я следующий код, который

-> Поиск Входящие в "searchKey"

-> Если находит в папке Входящие, отвечает на него

-> Если нет , она движется в подпапках Входящие и продолжает тот же процесс

Dim olApp As Outlook.Application 
Dim olNs As Namespace 
Dim Fldr As MAPIFolder 
Dim olFldr As MAPIFolder 
Dim olMail ' As Outlook.MailItem 
Dim i As Integer 

Set olApp = New Outlook.Application 
Set olNs = olApp.GetNamespace("MAPI") 
Set Fldr = olNs.GetDefaultFolder(olFolderInbox) 
Set olFldr = Fldr 

tryAgain: 

    For Each olMail In olFldr.Items 
     If InStr(olMail.Subject, searchKey) <> 0 Then 
      Set ReplyAll = olMail.ReplyAll 
      With ReplyAll 
       .HTMLBody = Msg & .HTMLBody 
       emailReady = True 
       .Display 
      End With 
     End If 
    Next olMail 


If Not emailReady Then 
    i = i + 1 
    If i > Fldr.Folders.Count Then 
     MsgBox ("The email with the given subject line was not found!") 
     Exit Sub 
    Else 
     Set olFldr = Fldr.Folders(i) 
     GoTo tryAgain 
    End If 
End If 

Этот код может быть запутанным и долго, поэтому, пожалуйста, дайте мне знать, если вам нужны какие-либо разъяснения.

Вопрос: Как я могу выполнить поиск по всему Outlook, не переходя вручную через каждую папку/подпапку/под-подпапку ... без этого метода и найти сообщение LAST в конкретном разговоре? Или, по крайней мере, как я могу оптимизировать этот код, чтобы я не пропустил какую-либо папку и знал даты и время отправки этих писем?

1

Вы можете использовать встроенную функцию AdvancedSearch, которая возвращает объект поиска, содержащий элементы. Они должны иметь свойства даты, поэтому вам нужен только код, чтобы пройти через объекты поиска и найти его с последней датой (ReceivedTime)?

Я предложил бы использовать нижний пример на этой странице - он получает объект таблицы из поиска, а затем использовать

Set MyTable = MySearch.GetTable 
Do Until MyTable.EndOfTable 
    Set nextRow = MyTable.GetNextRow() 
    Debug.Print nextRow("ReceivedTime") 
Loop 

Оттуда вы можете сделать сравнение, чтобы найти последний раз, и если вы хотите что-то сделать с помощью mailitem, вам нужно будет получить столбец «EntryID» из таблицы. Затем используйте метод GetItemFromID объекта NameSpace для получения полного элемента, так как таблица возвращает объекты только для чтения.

Вы также можете применить фильтр даты к поиску, если хотите, если знаете, например, минимальную дату.

  0

Я столкнулся с этой функцией, но не был уверен, достигнет ли она этого. Теперь, когда вы подтвердили, я попытаюсь использовать его. Большое спасибо! 09 мар. 162016-03-09 21:02:12

  0

Я немного отредактировал свой ответ, чтобы уточнить, что я буду делать 10 мар. 162016-03-10 02:07:45

  0

Очевидно, эта функция является функцией Outlook-VBA, поэтому я не могу ее использовать в Excel VBA. 10 мар. 162016-03-10 14:02:03

  0

Вам нужно будет позвонить через olApp (Outlook. Объект приложения), который вы создаете, например olApp.AdvancedSearch 10 мар. 162016-03-10 14:36:23

  0

Большое спасибо.это действительно сработало, но мне пришлось избавиться от части olApp.Session.DefaultStore.IsInstantSearchEnabled , потому что это дало бы мне ошибку «Не удалось найти объект». Вы знаете, почему это может быть так? 10 мар. 162016-03-10 15:42:17

  0

Я не уверен, извините. Возможно, попробуйте проверить, не является ли olApp.Session.DefaultStore Nothing (true false) при отладке. 10 мар. 162016-03-10 16:59:31


1

Чтобы пройти через все папки, выполните следующие действия: Пройдите один раз через все основные папки в Outlook, а затем для каждой основной папки пройдите через каждую подпапку. Если у вас больше филиалов, то угадайте, что вам нужно добавить дополнительные уровни в код «для каждой папки3 в папке2.folders». Также в условии if вы можете проверить дату отправки почты и перейти от новейшего к самому старому. Установите oMsg.display, чтобы узнать, какая почта проверяется.

Public Sub FORWARD_Mail_STAT_IN() 
Dim Session As Outlook.NameSpace 
Dim oOutLookObject As New Outlook.Application 
Dim olNameSpace As NameSpace 
Dim oItem As Object 
Dim oMsg As Object 
Dim searchkey As String 

Set oOutLookObject = CreateObject("Outlook.Application") 
Set oItem = oOutLookObject.CreateItem(0) 
Set olNameSpace = oOutLookObject.GetNamespace("MAPI") 

Set Session = Application.Session 
Set Folders = Session.Folders 
For Each Folder In Folders 'main folders in Outlook 

     xxx = Folder.Name 
      For Each Folder2 In Folder.Folders 'all the subfolders from a main folder 
      yyy = Folder2.Name 
      Set oFolder = olNameSpace.Folders(xxx).Folders(yyy) 'in each folder we search all the emails 

       For Z = oFolder.Items.Count To 1 Step -1 ' For Z = 1 To oFolder.Items.Count 
        With oFolder.Items(Z) 
        Set oMsg = oFolder.Items(Z) 

        If Format(oMsg.SentOn, "mm/dd/yyyy") = Format(Date, "mm/dd/yyyy") And InStr(1, LCase(oMsg.Subject), searchkey, vbTextCompare) > 0 Then 
oMsg.display 
         ' insert code 
         End If 
         End With 
        Next Z 
      Next Folder2 
     Next Folder 
  0

Большое спасибо за ввод. Я дам вам знать, как это происходит! 09 мар. 162016-03-09 21:00:33

+1

Возможно, вам будет интересно изучить эту технику для рекурсивной обработки папок http://stackoverflow.com/questions/2272361/can-i-iterate-through-all-outlook-emails-in-a-folder-including-sub-folders 09 мар. 162016-03-09 21:24:40