在Outlook中进行VBA搜索

Question

我有这个代码在我的文件夹中搜索.我有一个带有"草图"主题的电子邮件,但是VBA没有找到它(它转到ELSE子句)

任何人都可以说出错了吗？

Set olApp = GetObject(, "Outlook.Application")

Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
Set olItms = olFldr.Items

Set Mail = olItms.Find("[Subject] = ""*sketch*""") 'Tracking
If Not (Mail Is Nothing) Then
    'use mail item here

Else
    NoResults.Show
End If

Answer 1

这是一种使用Items Restrict进行搜索的方法.

这样运行速度很快,您无需遍历项目以查找与搜索条件匹配的项目.

Sub Search_Inbox()

Dim myOlApp As New Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim filteredItems As Outlook.Items
Dim itm As Object
Dim Found As Boolean
Dim strFilter As String


Set objNamespace = myOlApp.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)

strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%sketch%'"

Set filteredItems = objFolder.Items.Restrict(strFilter)

If filteredItems.Count = 0 Then
    Debug.Print "No emails found"
    Found = False
Else
    Found = True
    ' this loop is optional, it displays the list of emails by subject.
    For Each itm In filteredItems
     Debug.Print itm.Subject
    Next
End If


'If the subject isn't found:
If Not Found Then
    'NoResults.Show
Else
   Debug.Print "Found " & filteredItems.Count & " items."

End If

'myOlApp.Quit
Set myOlApp = Nothing

End Sub

Answer 2

你.Find不工作的原因是因为Items.Find不支持使用通配符.Items.Find也不支持搜索部分字符串.因此,要实际查找电子邮件,您需要删除通配符并将整个字符串包含在搜索条件中.

所以这是你的选择:

如果您知道要查找的完整主题行,请修改您的代码,如下所示:

Set Mail = olItms.Find("[Subject] = ""This Sketch Email""")

如果您没有(或不会)知道完整的主题,您可以遍历收件箱文件夹并搜索部分主题行,如下所示:

未经测试

Sub Search_Inbox()

Dim myOlApp As New Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.MAPIFolder
Dim myitems As Outlook.Items
Dim myitem As Object
Dim Found As Boolean

Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myitems = myInbox.Items
Found = False

For Each myitem In myitems
    If myitem.Class = olMail Then
        If InStr(1, myitem.Subject, "sketch") > 0 Then
            Debug.Print "Found"
            Found = True
        End If
    End If
Next myitem

'If the subject isn't found:
If Not Found Then
    NoResults.Show
End If

myOlApp.Quit
Set myOlApp = Nothing

End Sub

希望有所帮助!