我从Ricardo Diaz那里找到了这段代码。它贯穿始终。
我想搜索我收到或发送到特定电子邮件地址的最新电子邮件，而不是按主题搜索。
我更换了
searchString = "urn:schemas:httpmail:subject like '" & emailSubject & "'"
带有
searchString = "urn:schemas:httpmail:to like '" & emailSubject & "'"
搜索返回一个空对象。
在我的Outlook收件箱和已发送邮件中搜索发件人和收件人电子邮件地址的urn:schemas是什么？
这是我试图运行的代码：
在VBA模块中：
Public Sub ProcessEmails()
Dim testOutlook As Object
Dim oOutlook As clsOutlook
Dim searchRange As Range
Dim subjectCell As Range
Dim searchFolderName As String
' Start outlook if it isn't opened (credits: https://stackoverflow.com/questions/33328314/how-to-open-outlook-with-vba)
On Error Resume Next
Set testOutlook = GetObject(, "Outlook.Application")
On Error GoTo 0
If testOutlook Is Nothing Then
Shell ("OUTLOOK")
End If
' Initialize Outlook class
Set oOutlook = New clsOutlook
' Get the outlook inbox and sent items folders path (check the scope specification here: https://learn.microsoft.com/en-us/office/vba/api/outlook.application.advancedsearch)
searchFolderName = "'" & Outlook.Session.GetDefaultFolder(olFolderInbox).FolderPath & "','" & Outlook.Session.GetDefaultFolder(olFolderSentMail).FolderPath & "'"
' Loop through excel cells with subjects
Set searchRange = ThisWorkbook.Worksheets("Sheet1").Range("A2:A4")
For Each subjectCell In searchRange
' Only to cells with actual subjects
If subjectCell.Value <> vbNullString Then
Call oOutlook.SearchAndReply(subjectCell.Value, searchFolderName, False)
End If
Next subjectCell
MsgBox "Search and reply completed"
' Clean object
Set testOutlook = Nothing
End Sub
在名为clsOutlook:的类模块中
Option Explicit
' Credits: Based on this answer: https://stackoverflow.com/questions/31909315/advanced-search-complete-event-not-firing-in-vba
' Event handler for outlook
Dim WithEvents OutlookApp As Outlook.Application
Dim outlookSearch As Outlook.Search
Dim outlookResults As Outlook.Results
Dim searchComplete As Boolean
' Handler for Advanced search complete
Private Sub outlookApp_AdvancedSearchComplete(ByVal SearchObject As Search)
'MsgBox "The AdvancedSearchComplete Event fired."
searchComplete = True
End Sub
Sub SearchAndReply(emailSubject As String, searchFolderName As String, searchSubFolders As Boolean)
' Declare objects variables
Dim customMailItem As Outlook.MailItem
Dim searchString As String
Dim resultItem As Integer
' Variable defined at the class level
Set OutlookApp = New Outlook.Application
' Variable defined at the class level (modified by outlookApp_AdvancedSearchComplete when search is completed)
searchComplete = False
' You can look up on the internet for urn:schemas strings to make custom searches
searchString = "urn:schemas:httpmail:to like '" & emailSubject & "'"
' Perform advanced search
Set outlookSearch = OutlookApp.AdvancedSearch(searchFolderName, searchString, searchSubFolders, "SearchTag")
' Wait until search is complete based on outlookApp_AdvancedSearchComplete event
While searchComplete = False
DoEvents
Wend
' Get the results
Set outlookResults = outlookSearch.Results
If outlookResults.Count = 0 Then Exit Sub
' Sort descending so you get the latest
outlookResults.Sort "[SentOn]", True
' Reply only to the latest one
resultItem = 1
' Some properties you can check from the email item for debugging purposes
On Error Resume Next
Debug.Print outlookResults.Item(resultItem).SentOn, outlookResults.Item(resultItem).ReceivedTime, outlookResults.Item(resultItem).SenderName, outlookResults.Item(resultItem).Subject
On Error GoTo 0
Set customMailItem = outlookResults.Item(resultItem).ReplyAll
' At least one reply setting is required in order to replyall to fire
customMailItem.Body = "Just a reply text " & customMailItem.Body
customMailItem.Display
End Sub
Sheet1中的单元格A2:A4包含电子邮件地址，例如rainer@gmail.com例如。
您可以得到看起来是"；urn:schemas:httpmail:to"另一种方式
读取Outlook的对象模型中未公开的MAPI属性
其有用性仍有待证明，因为地址相关属性的值要么不可用，要么微不足道。
Option Explicit
' https://www.slipstick.com/developer/read-mapi-properties-exposed-outlooks-object-model/
Const PR_RECEIVED_BY_NAME As String = "http://schemas.microsoft.com/mapi/proptag/0x0040001E"
Const PR_SENT_REPRESENTING_NAME As String = "http://schemas.microsoft.com/mapi/proptag/0x0042001E"
Const PR_RECEIVED_BY_EMAIL_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x0076001E"
Const PR_SENT_REPRESENTING_EMAIL_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x0065001E"
Const PR_SENDER_EMAIL_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x0C1F001E"
Sub ShowPropertyAccessorValue()
Dim oItem As Object
Dim propertyAccessor As outlook.propertyAccessor
' for testing
' select an item from any folder not the Sent folder
' then an item from the Sent folder
Set oItem = ActiveExplorer.Selection.item(1)
If oItem.Class = olMail Then
Set propertyAccessor = oItem.propertyAccessor
Debug.Print
Debug.Print "oItem.Parent......................: " & oItem.Parent
Debug.Print "Sender Display name...............: " & oItem.Sender
Debug.Print "Sender address....................: " & oItem.SenderEmailAddress
Debug.Print "PR_RECEIVED_BY_NAME...............: " & _
propertyAccessor.GetProperty(PR_RECEIVED_BY_NAME)
Debug.Print "PR_SENT_REPRESENTING_NAME.........: " & _
propertyAccessor.GetProperty(PR_SENT_REPRESENTING_NAME)
Debug.Print "PR_RECEIVED_BY_EMAIL_ADDRESS......: " & _
propertyAccessor.GetProperty(PR_RECEIVED_BY_EMAIL_ADDRESS)
Debug.Print "PR_SENT_REPRESENTING_EMAIL_ADDRESS: " & _
propertyAccessor.GetProperty(PR_SENT_REPRESENTING_EMAIL_ADDRESS)
Debug.Print "PR_SENDER_EMAIL_ADDRESS...........: " & _
propertyAccessor.GetProperty(PR_SENDER_EMAIL_ADDRESS)
End If
End Sub
使用字符串比较筛选项目的格式示例
Private Sub RestrictBySchema()
Dim myInbox As Folder
Dim myFolder As Folder
Dim propertyAccessor As propertyAccessor
Dim strFilter As String
Dim myResults As Items
Dim mailAddress As String
' for testing
' open any folder not the Sent folder
' then the Sent folder
Set myFolder = ActiveExplorer.CurrentFolder
Debug.Print "myFolder............: " & myFolder
Debug.Print "myFolder.items.Count: " & myFolder.Items.Count
mailAddress = "email@somewhere.com"
Debug.Print "mailAddress: " & mailAddress
' Filtering Items Using a String Comparison
' https://learn.microsoft.com/en-us/office/vba/outlook/how-to/search-and-filter/filtering-items-using-a-string-comparison
'strFilter = "@SQL=""https://schemas.microsoft.com/mapi/proptag/0x0037001f"" = 'the right ""stuff""'"
'Debug.Print "strFilter .....: " & strFilter
' Items where PR_RECEIVED_BY_EMAIL_ADDRESS = specified email address
' This is the To
' No result from the Sent folder
' Logical as the item in the Sent folder could have multiple receivers
Debug.Print
Debug.Print "PR_RECEIVED_BY_EMAIL_ADDRESS"
strFilter = "@SQL=" & """" & PR_RECEIVED_BY_EMAIL_ADDRESS & """" & " = '" & mailAddress & "'"
Debug.Print "strFilter .....: " & strFilter
Set myResults = myFolder.Items.Restrict(strFilter)
Debug.Print " myResults.Count.....: " & myResults.Count
' Items where PR_SENT_REPRESENTING_EMAIL_ADDRESS = specified email address
Debug.Print
Debug.Print "PR_SENT_REPRESENTING_EMAIL_ADDRESS"
strFilter = "@SQL=" & """" & PR_SENT_REPRESENTING_EMAIL_ADDRESS & """" & " = '" & mailAddress & "'"
Debug.Print "strFilter .....: " & strFilter
Set myResults = myFolder.Items.Restrict(strFilter)
Debug.Print " myResults.Count.....: " & myResults.Count
' Items where SenderEmailAddress = specified email address
Debug.Print
Debug.Print "SenderEmailAddress"
strFilter = "[SenderEmailAddress] = '" & mailAddress & "'"
Debug.Print "strFilter .....: " & strFilter
Set myResults = myFolder.Items.Restrict(strFilter)
Debug.Print " myResults.Count.....: " & myResults.Count
' Items where PR_SENDER_EMAIL_ADDRESS = specified email address
Debug.Print
Debug.Print "PR_SENDER_EMAIL_ADDRESS"
strFilter = "@SQL=" & """" & PR_SENDER_EMAIL_ADDRESS & """" & " = '" & mailAddress & "'"
Debug.Print "strFilter .....: " & strFilter
Set myResults = myFolder.Items.Restrict(strFilter)
Debug.Print " myResults.Count.....: " & myResults.Count
End Sub