Как искать строку в папке сохраненных писем

Question

Мы находимся в процессе запуска новой производственной линии, и у нас много информации и электронных писем для общения. Мы хотим, чтобы вся информация собиралась в папке на сервере и чтобы люди, которым нужна информация, могли искать в текстовом поле, чтобы найти связанные темы. Поэтому я хочу найти строку в теле письма, но в настоящее время я знаю, как это сделать только в своем почтовом ящике, а не как в сохраненных письмах в папке. Код, который у меня есть на данный момент, таков и предназначен для макроса Excel:

Sub FindSubjectInEmails()
Dim outlookApp
Dim olNs As Outlook.Namespace
Dim Fldr As Outlook.MAPIFolder

Dim olMail As Variant

Dim myTasks

Dim sir() As String

Set outlookApp = CreateObject("Outlook.Application")

Set olNs = outlookApp.GetNamespace("MAPI")

Set Fldr = olNs.GetDefaultFolder(olFolderInbox)

Set myTasks = Fldr.Items

For Each olMail In myTasks
If (InStr(1, olMail.Body, "text_to_find", vbTextCompare) > 0) Then
  olMail.Display
  Exit For
   End If
  Next

End Sub

Answer 1

Это то, что вы пытаетесь?

Option Explicit

Sub Sample()
    Dim OutApp As Object, OutMsg As Object
    Dim msgFolder As String, emlFile As String

    Set OutApp = CreateObject("Outlook.Application")

    '~~> Change this to the relevant folder
    msgFolder = "C:\Users\routs\Desktop\Test\"

    emlFile = Dir(msgFolder & "\*.msg")

    '~~> Loop through the folder to work with the emails
    Do While Len(emlFile) > 0
        Set OutMsg = OutApp.Session.OpenSharedItem(msgFolder & emlFile)

        If (InStr(1, OutMsg.Body, "text_to_find", vbTextCompare) > 0) Then
            OutMsg.Display
            Exit Do
        End If

        emlFile = Dir
    Loop

    Set OutMsg = Nothing
    Set OutApp = Nothing
End Sub