如何在已保存的电子邮件文件夹中搜索字符串

时间:2019-01-11 10:22:47

标签: excel vba

我们正处于新生产线启动阶段,需要大量信息和电子邮件进行交流。我们想要的是将所有信息收集在服务器上的文件夹中,并且需要信息的人可以在文本字段中搜索以找到相关主题。所以我想要在电子邮件正文中搜索一个字符串,但是目前我只知道如何在我自己的邮箱中执行此操作,而不知道如何在文件夹中已保存的电子邮件中执行此操作。我现在拥有的代码是这个,并且是用于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

1 个答案:

答案 0 :(得分:0)

这是您要尝试的吗?

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