Ｋ２さんの雑記

■ Outlook2013で指定したMessage-IDのメールを検索して表示するマクロ(一応完了)

該当フォルダに飛んでからそのメールを選択する方法は、いろいろ試したがなかなかうまくいかない。

結局、そのメッセージIDのメールだけを選択するフィルタをかけることにした。スレッド表示でもフィルタはかかるし、そのスレッドを構成する他のメールも見えるようなので、一応実用レベルかと思う。

作業が終わったら、フィルタを解除する必要があるが、それを一発で行うマクロも書いた。

SearchEmailTPZ()
実行するとMessageId入力ダイアログが出る。
OKを押すと、該当フォルダに飛び、そのメールだけが表示される。
受信トレイ（InputBox）配下に検索対象フォルダがある必要がある）

FilterReset()
現在のフィルタをリセットする。

'===========================================================
' グローバル変数定義
'===========================================================
Public WithEvents myOlExp As Outlook.Explorer
Public ObjFoundMailItemTPZ As MailItem
Dim StrMessageID As String

'===========================================================
' システムイベント
'===========================================================
'-----------------------------------------------------------
'  起動時イベント
'-----------------------------------------------------------
Private Sub Application_Startup()
 Set myOlExp = Application.ActiveExplorer
 '---- SearchEmailTPZ()より
 Set ObjFoundMailItemTPZ = Nothing
End Sub

'-----------------------------------------------------------
'  現在のエクスプローラのフォルダー変更イベント
'-----------------------------------------------------------
Private Sub myOlExp_FolderSwitch()
    Dim sFilter As String

    '---- SearchEmailTPZ()より
    If Not ObjFoundMailItemTPZ Is Nothing Then
        DoEvents

        'メッセージIDのフィルタをかける
        sFilter = _
            """http://schemas.microsoft.com/mapi/proptag/0x1035001E"" = " _
            & " '" & StrMessageID & "'"
        ActiveExplorer.CurrentView.filter = sFilter
        ActiveExplorer.CurrentView.Save
        ActiveExplorer.CurrentView.Apply
        Set ObjFoundMailItemTPZ = Nothing
    End If
End Sub

'===========================================================
'  現在のフィルタをリセットする
'===========================================================
Public Sub FilterReset()
    ActiveExplorer.CurrentView.filter = ""
    ActiveExplorer.CurrentView.Save
    ActiveExplorer.CurrentView.Apply
End Sub

'===========================================================
'  メッセージIDのメールを検索してフォルダに移動
'    その後、FolderSwitchイベントでそのメッセージIDのメール
'    のみ表示するフィルタをかける
'    (myOlExp_FolderSwitch()で遅延実行)
'===========================================================
Public Sub SearchEmailTPZ()
    Dim oCurrentSelectedItem As MailItem
    Dim oFolder As Folder, intWait As Integer
    Dim sFilter As String
    Dim objSel

    StrMessageID = InputBox(Prompt:="MessageId検索", _
     Title:="MessageId検索")
    Set ObjFoundMailItemTPZ = SearchEmailByMessageID(StrMessageID)
    If Not ObjFoundMailItemTPZ Is Nothing Then
        Set oFolder = ObjFoundMailItemTPZ.Parent
        If ActiveExplorer.CurrentFolder <> oFolder Then
            Set ActiveExplorer.CurrentFolder = oFolder
        Else
            myOlExp_FolderSwitch
        End If
    End If
End Sub

'-----------------------------------------------------------
'  メッセージIDでメールを検索
'-----------------------------------------------------------
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

'-----------------------------------------------------------
'  メッセージIDでメールを検索(再起関数)
'-----------------------------------------------------------
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

さて、次は、TaskPrizeからこの関数を自動的に呼び出してMessageIDを渡す方法を考えたい。そんな方法はあるのだろうか。