エクセルで複数人へのアウトルック予定表反映方法について

Question

エクセルでアウトルックの予定表へ反映させるために下記のVBAを実行しています。
その際、自分以外の他人のアウトルック予定表にも同じものを反映させるためにはどのような処理が必要でしょうか。

'Outlook用の定義
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace
Dim olFolder As Folder
Dim olConItems As Outlook.Items
Dim olItem  As AppointmentItem
Dim checkFlg As Long

'重複チェックフラグ初期値設定
checkFlg = 0



'Excel用の定義
Dim wbBook As Workbook
Dim wsSheet As Worksheet

Dim lnContactCount As Long

'スクリーンの更新は行われません。
Application.ScreenUpdating = False

'Excelのブックとワークシートのオブジェクトを設定します。
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets(1)


wsSheet.Activate

'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの予定表を取得します。
Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar)
Set olConItems = olFolder.Items

'取得結果を記述する行番号を指定します。2行目のセルから開始されることになります。
lnContactCount = 2

Dim rc As Integer
rc = MsgBox("予定表へ登録しますか？", vbYesNo + vbQuestion, "確認")

If rc = vbYes Then

    '予定表一覧の件数分繰り返す。
    For i = lnContactCount To Cells(1, 1).End(xlDown).Row
        Set olItem = olApp.CreateItem(olAppointmentItem)

        With olItem
            .RequiredAttendees = Cells(i, 1)
            .OptionalAttendees = Cells(i, 2)
            .Subject = Cells(i, 3)
            .Body = Cells(i, 4)
            .Start = Cells(i, 5)
            .End = Format(Cells(i, 6), "yyyy/mm/dd hh:mm:ss")
            .Body = Format(Cells(i, 7), "yyyy/mm/dd hh:mm:ss")
            .Body = Cells(i, 8)

            
            '重複チェック
            For Each olItemBefor In olConItems
                If TypeName(olItemBefor) = "AppointmentItem" Then
                    '登録されている予定表の件名と開始日時が一致していたらフラグを1にする
                    If olItemBefor.Subject = .Subject And olItemBefor.Start = .Start Then
                      checkFlg = 1
                    End If
                End If
                
            Next

            If checkFlg <> 1 Then
                'ここで保存
                olItem.Save
                
            End If

        End With
        
        '重複フラグリセット
        checkFlg = 0

    Next

Else
    MsgBox "処理を中断します"
End If

'Null out the variables.
Set olItem = Nothing
Set olApp = Nothing

        
'Turn screen updating back on.
Application.ScreenUpdating = True

MsgBox "Outlook予定表の登録が完了しました！", vbInformation

End Sub

Comments

[m.ts10806]

VBA OUTLOOK スケジュール登録
で調べたら「他人のOutLook予定表を」
というのが出てきますが、そのように調べたり試したりされましたか？
（古い情報で適用できなかったというのでしたらその旨も記載してほしい）

[gdngnd]

試しましたが、「 Set olFolder = olNamespace.GetSharedDefaultFolder(recOther, olFolderCalendar)」でエラーが出たため、できませんでした。

[m.ts10806]

どう書いてどういうエラーが出たかによると思います。
コピペだけでは動かないでしょうし、Officeのバージョンとどのエディションかによると思います

Answer 1

Exchangeサーバー環境で他人の予定表に書き込むアクセス権があれば、他人の予定表フォルダーは以下のようにして取得できます。

Dim olRec As Outlook.Recipient
Set olRec = olNamespace.CreateRecipient("メールアドレス")
Set olFolder = olNamespace.GetSharedDefaultFolder( olRec, olFolderCalendar )

こうして取得した予定表フォルダーへの書き込みは自分の予定表と同様に行えます。
書き込み権限がないのであれば、会議出席依頼として送信する必要があります。
会議出席依頼の送信方法については以下の URL が参考になります。
https://docs.microsoft.com/ja-jp/office/vba/outlook/how-to/items-folders-and-stores/create-an-appointment-as-a-meeting-on-the-calendar