VBA Поиск в Outlook

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

Причина ваш .Find не работает, потому что Items.Find не поддерживает использование подстановочных символов. Items.Find также не поддерживает поиск частичные струны. Чтобы на самом деле найти электронное письмо, вам нужно удалить подстановочные знаки и включить всю строку в критерии поиска.

Так вот ваши варианты:

Если вы знаете полную сюжетную линию, которую вы ищете, модифицирующие свой код следующим образом:

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

Если вы не (или не будет) знать полную тему, вы можете перебрать папку Входящие и поиск частичной сюжетной линии, как так:

UNTESTED

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 

Надеюсь, что это поможет!

Answer 2

Ниже приведен способ поиска с использованием Ограничения элементов.

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

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