Поиск VBA в Outlook
У меня есть этот код, чтобы найти в моей папке. У меня есть электронное письмо с темой "эскиз", но 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
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
надеюсь, что это поможет!
вот способ сделать поиск с помощью элементов 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