Outlook の VBA で既定以外のフォルダーを取得する

Outlook に登録されている予定を取得するプログラムを作成した際に、常に既定の予定表フォルダーが対象となるようにプログラムしていました。しかし、Outlook は複数のフォルダーを作ることができるため、既定以外のフォルダーを取得する方法を、予定表を例にまとめました。

既定のフォルダーを取得する方法

既定以外のフォルダーを取得する前に、まず、既定のフォルダーを取得する方法です。少し違和感があるかもしれませんが、予定表もフォルダーの一種として扱われます。

Dim l_calendar As Outlook.Folder
Set l_calendar = Application.Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderCalendar)

既定以外のフォルダーの例

既定以外のフォルダーというのは、たとえば次のような場合です。

[Outlook] 既定の予定表とは別に予定表がある
既定の予定表とは別に予定表がある

予定表の中にさらに予定表が入っています。実際はこのようにすることはあまりないかもしれませんが、今回はテストなので、あえてこのようにしました。

既定以外の予定表を取得するには

既定以外のフォルダを取得する場合は、ルート フォルダーから目的のフォルダーまで順にたどっていく必要があります。上の例の場合は、「テスト用 Outlook データファイル」フォルダー取得 → 「テスト用予定表」フォルダー取得 → 「テスト用予定表2」フォルダー取得、という流れです。

指定したパスに従って、フォルダーを順にたどっていく関数は次の通りです。

' 指定したパスの Outlook フォルダーを取得します。
' <params>
'   p_folderPath
'       フォルダーのパス。
' <returns>
'   p_folderPath が示す Outlook フォルダー。存在しない場合は Nothing。
Private Function GetOutlookFolder(ByVal p_folderPath As String) As Outlook.Folder
    If Left(p_folderPath, 2) = "\\" Then
        p_folderPath = Right(p_folderPath, Len(p_folderPath) - 2)
    End If
    
    ' フォルダーのパスを、フォルダー名ごとに分けて配列にします。
    Dim l_folderNames As Variant
    l_folderNames = Split(p_folderPath, "\")
    
    Dim l_folder As Outlook.Folder
    
    Dim l_folders As Outlook.Folders
    Set l_folders = Application.Session.Folders
    
    ' フォルダーを検索し、見つかればそのフォルダーを基点としてさらに子フォルダーを検索します。
    ' これをフォルダーの階層分繰り返して、目的のフォルダーを探します。
    For Each l_folderName In l_folderNames
        Set l_folder = l_folders.Item(l_folderName)
        
        If l_folder Is Nothing Then Exit Function
        
        Set l_folders = l_folder.Folders
    Next
    
    Set GetOutlookFolder = l_folder
End Function

関数を呼ぶ側は次のようになります。

Dim l_calendar As Outlook.Folder
Set l_calendar = GetOutlookFolder("\\テスト用 Outlook データ ファイル\テスト用予定表\テスト用予定表2")

これで、既定の予定表以外も取得できます。また、予定表だけではなく、他の種類のフォルダーも同様に取得できます。

kpdn

お寿司とゲームと動物が好きな、フリーランスのエンジニアです。フロントエンドからインフラまで日々奮闘中です。最近は物忘れがどんどんがひどくなってきました。

コメントを残す