【VBA】Notesカレンダーを取得する簡単なサンプル【繰り返し予定対応バージョン】

検証した環境
Notesカレンダーから繰り返し予定もちゃんと取得できるVBAのコード
終わりに

以前、HCL (旧Lotus、IBM)Notesカレンダーから予定を取得するサンプルを紹介しましたが、繰り返し予定がうまく取得できない！！というコメントを頂いておりました。遅ればせながら、繰り返し予定も取得できるように改良しましたのでご笑納ください。

コメントを頂きました記事⇒VBAでNotesカレンダーを取得する簡単なサンプル - 適材適所

PowerShellで同じことをやっている記事⇒Notesカレンダーを取得する【PowerShell】 - 適材適所

検証した環境

Windows10
Notes 9
Excel 2019

Notesカレンダーから繰り返し予定もちゃんと取得できるVBAのコード

参照設定でLotus Domino Objectにチェックを入れてください。

その他、サーバー名など設定項目でわからないことがあれば、下記の記事をご参照ください。画像付きで確認方法を掲載しています。

⇒VBAでNotesメールを作成・送信する_最も簡単なサンプル - 適材適所

下記のコードを実行すると、アクティブシートに予定のタイトル、内容、開始日、終了日、予定の種類、一日の予定かどうかが書き込まれます。予定の種類はAppointmentが会議や予定、Taskがタスクです。一日の予定の場合、開始日と終了日には日にちだけが入ります。一日の予定でない場合は時間も入ります。また、繰り返し予定の場合、まとめて取得していますので、このままだと日付順になっていません。そのため、必要に応じて並び替えをするなどしてください。

Sub printNotesCalendarList()
    Const PASSWORD As String = "パスワードを設定してください"
    Const SERVER As String = "サーバー名を設定してください"
    Const NOTES_FILE As String = "ファイル名を設定してください"
    'セッションを確立
    Dim notesSession As notesSession: Set notesSession = New notesSession
    notesSession.Initialize PASSWORD
    'Notesのデータベースを取得
    Dim notesDB As NotesDatabase: Set notesDB = notesSession.GetDatabase(SERVER, NOTES_FILE)
    'カレンダーViewの取得
    Dim view As NotesView: Set view = notesDB.GetView("$Calendar")
    
    'カレンダーの最初の文書を取得
    Dim notesDoc As NotesDocument: Set notesDoc = view.GetFirstDocument
    
    '繰り返し予定対策のため、一度処理した予定の親IDを格納しておく連想配列
    Dim parentUNIDDic As Object: Set parentUNIDDic = CreateObject("Scripting.Dictionary")
    
    'for文用変数
    Dim i As Long
    
    'シートの見出し作成
    Application.ScreenUpdating = False
    Dim currentRow As Long: currentRow = 2
    
    Cells(1, 1) = "タイトル"
    Cells(1, 2) = "内容"
    Cells(1, 3) = "開始日"
    Cells(1, 4) = "終了日"
    Cells(1, 5) = "予定の種類"
    Cells(1, 6) = "一日の予定？"
    
    '全てのカレンダーにアクセスする
    Do Until (notesDoc Is Nothing)
        '親IDを一度取得している場合はスキップする
        Select Case notesDoc.ParentDocumentUNID
            Case "":
            Case Else
                If parentUNIDDic.Exists(notesDoc.ParentDocumentUNID) Then
                    GoTo CONTINUE
                Else
                    '繰り返し対策のため親IDを格納する
                    parentUNIDDic.Add notesDoc.ParentDocumentUNID, notesDoc.ParentDocumentUNID
                End If
        End Select
        
        '開始・終了日付を取得するための準備
        Dim startName As String
        Dim endName As String
        Dim allDay As Boolean
        If notesDoc.GetItemValue("AppointmentType")(0) = "3" Then
            startName = "StartDateTime"
            endName = "EndDateTime"
            allDay = False
        Else
            startName = "StartDate"
            endName = "EndDate"
            allDay = True
        End If
        
        Dim subject As String: subject = notesDoc.GetItemValue("Subject")(0)
        Dim body As String: body = notesDoc.GetItemValue("Body")(0)
        Dim form As String: form = notesDoc.GetItemValue("Form")(0)
        For i = 0 To UBound(notesDoc.GetItemValue(startName))
            Cells(currentRow, 1) = subject
            Cells(currentRow, 2) = body
            Cells(currentRow, 3) = notesDoc.GetItemValue(startName)(i)
            Cells(currentRow, 4) = notesDoc.GetItemValue(endName)(i)
            Cells(currentRow, 5) = form
            Cells(currentRow, 6) = allDay
            currentRow = currentRow + 1
            'イミディエイトウィンドウに書き出す場合
'            Debug.Print "タイトル：" & subject
'            Debug.Print "内容：" & body
'            Debug.Print "開始日:" & notesDoc.GetItemValue(startName)(i)
'            Debug.Print "終了日:" & notesDoc.GetItemValue(endName)(i)
'            Debug.Print "予定の種類:" & form
'            Debug.Print "---------------------------------"
        Next i
        
CONTINUE:
        '次の文書を取得する
        Set notesDoc = view.GetNextDocument(notesDoc)
        DoEvents
    Loop
    
    Application.ScreenUpdating = True
    
End Sub

終わりに

Notesのスケジュールを「比較的ちゃんと」取得できるプログラムを作ってみました。

こういうケース対応できてないよ！？などありましたらコメントやTwitterなどで教えて頂けると幸いです。

世界中のNotesユーザーに幸あれ！！

というわけで、ここまでお読みいただきありがとうございました。

リンク