用于在Outlook邮件中搜索的Excel VBA

Question

我正在开发一个项目,其中我有一个帐户ID列表,我正在尝试做的是创建一个将与Outlook连接的宏,在我的收件箱中搜索具有特定条件的任何电子邮件,然后返回"如果找到Y"或"N",如果找到,则发送电子邮件的人和发送的时间.下面是我正在使用的代码; 我需要宏来搜索电子邮件的正文而不是主题行.当我用[Body]替换[Body]时,宏运行没有错误,但没有返回电子邮件(我放置了几个测试电子邮件以便捕获).我正在运行Excel和Outlook 2007,并且已经在VBA中引用了MS 12.0 Excel和Outlook库.

Sub Work_with_Outlook()

    Set outlookApp = CreateObject("Outlook.Application")

    Dim olNs As Outlook.Namespace
    Dim Fldr As Outlook.MAPIFolder
    Dim olMail As Variant
    Dim sir() As String

    Set outlookApp = New Outlook.Application
    Set olNs = outlookApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
    Set myTasks = Fldr.Items

    Set olMail = myTasks.Find("[Subject] = ""123456""")
    If Not (olMail Is Nothing) Then
        olMail.Display
    End If

End Sub

Answer 1

你不能在Find(Filter)中使用Body,参见Items.Find Method(Outlook),作为一种解决方法,你可以使用VBA字符串搜索功能:

Sub sofWorkWithOutlook20082550()
  Dim outlookApp
  Dim olNs As Outlook.Namespace
  Dim Fldr As Outlook.MAPIFolder
  Dim olMail As Variant
  Dim myTasks
  Dim sir() As String

  'Set outlookApp = New Outlook.Application
  Set outlookApp = CreateObject("Outlook.Application")

  Set olNs = outlookApp.GetNamespace("MAPI")
  Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
  Set myTasks = Fldr.Items

  '
  'Set olMail = myTasks.Find("[Subject] = ""123456""")
  '
  For Each olMail In myTasks
  '
    If (InStr(1, olMail.Body, "My-Text-to-Search", vbTextCompare) > 0) Then
      olMail.Display
      Exit For
    End If
  Next

End Sub