私はメーラーに、Microsoft Office の Outlook を使用している。

この Outlook で、以下の不満がある。
Outlook上で検索を行い、検索結果として一覧されたメールアイテムが、どのフォルダに格納されているかが分からない。
特定のフォルダ上で検索を行う場合はそれでよいが、「すべてのメールボックス」を対象に検索した場合など、検索結果には表示されるけれど、その前後のメールを読みたいとか、どのプロジェクトのメールなのか、検索結果からはわからない。
ビューの設定で「フォルダ」列を追加すれば、そのメールアイテムの直上のフォルダ名はわかる。しかし、パスは分からない。
たとえば、プロジェクトごとにフォルダを分け、更にそのプロジェクト配下にサブフォルダを作って管理していたりすると、そのサブフォルダ名までしかわからないので、どのプロジェクトのサブフォルダなのかが分からない。
すなわち、以下のような構成にしていると、メールアイテムが「やりとり」「メモ」「アクセス情報」に格納されていることは分かるけれど、どのプロジェクトに格納されているのかは分からない。
+プロジェクト①
+やりとり
+メモ
+アクセス情報
+プロジェクト②
+やりとり
+メモ
+アクセス情報
+プロジェクト③
+やりとり
+メモ
+アクセス情報
検索でヒットしたメールアイテムの前後のメールを読みたくても、関連情報を調べたくても、調べたいフォルダにアクセスできないのである。
そこで、選択したメールアイテムから親フォルダを探索し、パスを求めて表示するマクロを作ってみた。
こちら。
Option Explicit
'
' 選択されているメールアイテムのパスを取得する。
'
Sub FindMailItemTree()
Dim strAllPath As String
Dim objSelect As Outlook.Selection
Dim lngItem As Long
' パス一覧をクリアする。
strAllPath = ""
' 選択されているアイテムを取得する。
Set objSelect = Outlook.Application.ActiveExplorer.Selection
If objSelect.Count <= 0 Then
Call MsgBox("メールアイテムを選択してください。")
Exit Sub
End If
' 選択されているアイテムを走査する。
For lngItem = 1 To objSelect.Count Step 1
Dim strPath As String
Dim objItem As Object
' パスをクリアする。
strPath = ""
' アイテムを取得する。
Set objItem = objSelect.Item(lngItem)
' パスを走査する。
Do While True
Dim strName As String
' アイテムの名前を取得する。
Select Case UCase(TypeName(objItem))
' メールアイテム?
Case UCase("MailItem")
strName = "【" & objItem.Subject & "】"
' フォルダ?
Case UCase("MAPIFolder")
strName = objItem.Name
' 上記以外
' 終了する。
Case Else
Exit Do
End Select
' パスに名前を追加する。
If strPath <> "" Then
strPath = "\" & strPath
End If
strPath = strName & strPath
' 親アイテムを取得する。
Set objItem = objItem.Parent
Loop
' パス一覧に追加する。
strAllPath = strAllPath & strPath & vbCrLf & vbCrLf
Next lngItem
' パス一覧を表示する。
Call MsgBox(strAllPath)
End Sub
このマクロをOutlookに登録し、メールアイテムを選択して実行すると、そのメールアイテムのパスが、たとえば、以下の様に表示される。
プロジェクト①\やりとり\【メールの表題】
このマクロでは、パスの表示のみを行っているが、フォルダが取得されている状態で以下の様にすれば、そのフォルダを開く事もできると思う。
Call objItem.Display()
このプログラムは自由に使って頂いて構いませんが、自己責任でお願いします。