Ｋ２さんの雑記

■ Outlookで指定したMessage-IDのメールを検索して表示するマクロ(挑戦中)

題目の通り、まずはマクロでMessage-ID検索を作ろうとした。

Message-IDに対応するメールを検索し、存在するフォルダを表示するところまではできたのだが、そのメールを選択状態にするところではまった。

Webを検索して情報を調べているのだが、どうも誰もできていなさそう。そんな簡単そうなことができないなんて、どういう事なんだろう。

P.S. naoさん、助けてください！

Public Sub SearchEmailTPZ()
   Dim oMailItem, oCurrentSelectedItem As MailItem
   Dim oFolder As Folder, intWait As Integer
   '以下の""内に、該当メールのMessage-IDを書く
   Set oMailItem = SearchEmailByMessageID _
       ("<1111111111111@prod.outlook.com>")
   If Not oMailItem Is Nothing Then
       Set oFolder = oMailItem.Parent
       '↓これでフォルダを開くところまではOK
       Set ActiveExplorer.CurrentFolder = oFolder
       '↓ここができない。書いてあるコードでは動作しない
       ActiveExplorer.ClearSelection
       ActiveExplorer.AddToSelection oMailItem
   End If
End Sub

Private Function SearchEmailByMessageID(MessageID As String) As MailItem
   Dim oFolder As Folder
   Dim sQuery As String
   sQuery = _
    "@SQL=""http://schemas.microsoft.com/mapi/proptag/0x1035001E"" = " _
    & " '" & MessageID & "'"
   Set oFolder = ActiveExplorer.Session.GetDefaultFolder(6)
   Set SearchEmailByMessageID = SearchEmailByQuery(sQuery, oFolder)
End Function

Private Function SearchEmailByQuery(oQuery As String, _
       oFolder As Folder) As MailItem
   Dim oFoundMail As MailItem, loFolder As Folder
   Set oFoundMail = oFolder.Items.Find(oQuery)
   If oFoundMail Is Nothing Then
       For Each loFolder In oFolder.Folders
           Set oFoundMail = SearchEmailByQuery(oQuery, loFolder)
           If Not oFoundMail Is Nothing Then
               Exit For
           End If
       Next
   End If
   Set SearchEmailByQuery = oFoundMail
End Function