使用 urn:schemas 按电子邮件地址搜索 [英] Search by Email address with urn:schemas

问题描述

我从 Ricardo Diaz 找到了此代码.它贯穿始终.

I found this code from Ricardo Diaz. It runs through.

我想搜索我收到或发送到特定电子邮件地址的最新电子邮件，而不是按主题进行搜索.

I would like to search for the latest email I received or sent to a specific email address as opposed to search by subject.

我换了

searchString = "urn:schemas:httpmail:subject like '" & emailSubject & "'"

与

searchString = "urn:schemas:httpmail:to like '" & emailSubject & "'"

搜索返回一个空对象.

在我的 Outlook 收件箱和已发送邮件中搜索发件人和收件人的电子邮件地址的 urn:schemas 是什么?

What is the urn:schemas to search for the email address of the sender and receiver in my Outlook Inbox and Sent Items?

这是我要运行的代码:

在 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://docs.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 的类模块中:

In a class module named 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 包含电子邮件地址，例如 [e-mail].

The cells A2:A4 in Sheet1 contain email address such as [e-mail] for instance.

推荐答案

您可以访问看似urn:schemas:httpmail:to"的内容另一种方式.
读取未在 Outlook 的对象模型中公开的 MAPI 属性

You can get to what appears to be "urn:schemas:httpmail:to" another way.
Read MAPI properties not exposed in Outlook's Object Model

有用性仍有待证明，因为来自地址相关属性的值要么不可用，要么微不足道.

The usefulness is still to be proven as the values from the the address-related properties are either not available or trivial.

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 = "[e-mail]"
    
    Debug.Print "mailAddress: " & mailAddress
    
    ' Filtering Items Using a String Comparison
    ' https://docs.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

这篇关于使用 urn:schemas 按电子邮件地址搜索的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！