スキルアップ・問題解決なら、モーグにおまかせ！

下記の項目を選択してコンボボックス１で選択した人のOutlook予定表にそれぞれ入力になるようにしたいです。
ComboBox1→Aさん、Bさん、Cさん
ComboBox2 →内容
ComboBox3→日にち
ComnoBox4→開始時間
ComboBox5→終了時間
CommandButton1→Outlook予定表へ入力実行
 
初心者なので色々なサイト等参考にしながら作成したのですが、他の人のメールアドレスを指定しても全て自分のOutlook予定表に登録されます。
コードの順番、何が足りないのか等試行錯誤しましたが手詰まりでずっと改善されなく、こちらに投稿いたしました。
お解りになる方、ご教授お願いします。
 

Private Sub CommandButton1_Click()
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolder As Outlook.Folder
    Dim olConItems As Outlook.Items
    Dim olItem As Outlook.AppointmentItem
    Dim olAppointment As Outlook.AppointmentItem
    Dim rc As String
    Dim selectedName As String
    Dim emailAddress As String
    
    Const EMAIL_A As String = "〇〇@outlook.jp"
    Const EMAIL_B As String = "△△@outlook.jp"
    Const EMAIL_C As String = "□□@outlook.jp"
    
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then
        Set olApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
    
    selectedName = ComboBox1.Value
    
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set recOther = olNamespace.CreateRecipient(selectedName)
    Set olFolder = olNamespace.GetShareDefaultFolder(recOther, olFolderCalendar)
    Set olConItems = olFolder.Items
    Set olAppointment = olApp.CreateItem(olAppointmentItem)
    
    
    
    Select Case selectedName
        Case "Aさん"
            emailAddress = EMAIL_A
        Case "Bさん"
            emailAddress = EMAIL_B
        Case "Cさん"
            emailAddress = EMAIL_C
        Case Else
            MsgBox "選択されたアドレスがありません"
            Exit Sub
    End Select
    
    rc = MsgBox("予定表へ登録しますか？", vbYesNo + vbQuestion, "確認")
    
    If rc = vbYes Then
        Set olItem = olApp.CreateItem(olAppointmentItem)
          With olAppointment
             .Subject = Me.ComboBox2.Text & "の予定"
             .Body = Me.ComboBox2.Text
             .Start = Me.ComboBox3.Text & " " & Me.ComboBox4.Text
             .End = Me.ComboBox3.Text & " " & Me.ComboBox5.Text
             .Recipients.Add emailAddress
             .Save
          End With
     End If
    
    MsgBox "予定が登録されました"

引用:
初心者なので色々なサイト等参考にしながら作成したのですが、他の人のメールアドレスを指定しても全て自分のOutlook予定表に登録されます。

引用:
Outlookで共有された予定表を表示する
Outlookカレンダーの予定表を他メンバーから共有された場合、まず自身のOutlookアカウントに「予定表共有のお知らせ」メールが届きます。
メールでは、以下の内容を確認できます。
 
予定表が共有された旨
予定表を作成したユーザーの名前・アドレス
自分に付与された予定表のアクセス権限
この旨の下に承諾ボタン（「Accept and view calendar」ボタン）が設置されており、ボタンを押すと予定表欄から共有された予定表を確認できます。
 
共有された予定表は、自分のOutlookカレンダーに追加する形で書き込まれ、自分のスケジュールと共有されたスケジュールがまとめて表示されます。

アドバイスありがとうございます。
参考になるサイトも教えていただきたすかります。
色々と検索しましたがこのサイトは見れていませんでした。
  
コードに問題はないようでしたら…共有設定の部分かと悩んでいましたが
入力したい予定表（ＡさんＢさん…）に手動では登録したり削除できていたので
ＶＢＡでもできるものと思っていましたが、それ以外にも設定等必要なのか確認してみます。
  
そもそもコードが間違っているのだろうと思っていたので（でもどうすればいいのかわからなく）
こちらに質問させていただきました。
共有の設定等もう１度確認してみます。

回答ではありません。
 
「Excel のデータをほかのユーザーの予定表に書き込むマクロ」
https://outlooklab.wordpress.com/2012/10/27/excel-%e3%81%ae%e3%83%87%e3%83%bc%e3%82%bf%e3%82%92%e3%81%bb%e3%81%8b%e3%81%ae%e3%83%a6%e3%83%bc%e3%82%b6%e3%83%bc%e3%81%ae%e4%ba%88%e5%ae%9a%e8%a1%a8%e3%81%ab%e6%9b%b8%e3%81%8d%e8%be%bc%e3%82%80/
が参考になりませんか？
いずれにせよ、こちらのoutlook研究所にほとんどの情報はありそうな気がしています。

アドバイスありがとうございます。
このサイトも見つけられていませんでした。
とても参考になります。
共有の設定のサイトとこのサイトのコードを参考にして、再度作ってみます。

引用:
コードに問題はないようでしたら…共有設定の部分かと悩んでいましたが
入力したい予定表（ＡさんＢさん…）に手動では登録したり削除できていたので
ＶＢＡでもできるものと思っていましたが、それ以外にも設定等必要なのか確認してみます。

色々と教えていただきありがとうございます。
職場で利用するために作成しているのですがExchange経由になっています。
色々とアドバイスや参考になるサイト等教えていただき、それを元に明日実際に予定表に登録になるか試してみようと思います。

共有の設定については大丈夫でした。
ですが自分の予定表に入力になるため、サイト等参考にしてコードを少し改良したのですが、olFolder,olConItems,olAppointment等がNothingでエラーが出ます。
コードの順番等色々試行錯誤しているのですが、どの部分に問題があるのか不明です。
中々解決せず申し訳ないのですが、どの部分に問題があるのかお解りになる方、ご教授お願いします。
 
 
Private Sub CommandButton1_Click()
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolder As Outlook.Folder
    Dim olConItems As Outlook.Items
    Dim olItem As Outlook.AppointmentItem
    Dim olAppointment As Outlook.AppointmentItem
    Dim rc As String
    Dim selectedName As String
    Dim emailAddress As String
    Dim olRec As Outlook.Recipient
 
     
    Const EMAIL_A As String = "〇〇@outlook.jp"
    Const EMAIL_B As String = "△△@outlook.jp"
    Const EMAIL_C As String = "□□@outlook.jp"
     
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then
        Set olApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
     
    selectedName = ComboBox1.Value
     
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olRec = olNamespace.CreateRecipient(selectedName)
    Set olFolder = olNamespace.GetShareDefaultFolder(olRec, olFolderCalendar)
    Set olConItems = olFolder.Items
    Set olAppointment = olApp.CreateItem(olAppointmentItem)
     
     
     
    Select Case selectedName
        Case "Aさん"
            emailAddress = EMAIL_A
        Case "Bさん"
            emailAddress = EMAIL_B
        Case "Cさん"
            emailAddress = EMAIL_C
        Case Else
            MsgBox "選択されたアドレスがありません"
            Exit Sub
    End Select
     
    rc = MsgBox("予定表へ登録しますか？", vbYesNo + vbQuestion, "確認")
     
    If rc = vbYes Then
        Set olItem = olApp.CreateItem(olAppointmentItem)
          With olAppointment
             .MeetingStatus = olMeeting
             .Subject = selectedName & "の予定"
             .Body = Me.ComboBox2.Text
             .Start = Me.ComboBox3.Text & " " & Me.ComboBox4.Text
             .End = Me.ComboBox3.Text & " " & Me.ComboBox5.Text
             .Recipients.Add emailAddress
             .Save
          End With
     End If
     
    MsgBox "予定が登録されました"
     
End Sub

Exchange は使っていないのでテストできませんので
予定共有そのものの実行までは判りません。
 
テストと捉えた場合のコードの組み方
コードそのものの評価について
 
・予定共有そのものについて、VBAでの動作確認もできていない状態ですので
　まずは、それをVBAにて予定共有を行うコードをめざす。
　　ボタントリガーではなく、標準モジュールで良い
　　コンボボックス等余計なものはそぎ落とし、Select Case　や、MsgBoxは最低限で良い
 
　まずはテストなので、Aさん〜Cさんの選択はあとから、今はAさん決め打ち。
　Select Case や、MsgBoxは省く。日時も直打ちにてテストすれば良い。
そうなると、下記の様なコードになるかと。
 

Sub TEST()
  Dim olApp As Outlook.Application
  Dim olNamespace As Outlook.Namespace
'  Dim olFolder As Outlook.Folder
'  Dim olConItems As Outlook.Items
  Dim olItem As Outlook.AppointmentItem
  Dim olAppointment As Outlook.AppointmentItem
'  Dim rc As Long 'As String
  Dim selectedName As String
  Dim emailAddress As String
'  Dim olRec As Outlook.Recipient

  Const EMAIL_A As String = "〇〇@outlook.jp"

  Set olApp = GetObject(, "Outlook.Application")

  selectedName = "Aさん"
  emailAddress = EMAIL_A

  Set olNamespace = olApp.GetNamespace("MAPI")
'  Set olRec = olNamespace.CreateRecipient(selectedName)
'  Set olFolder = olNamespace.GetShareDefaultFolder(olRec, olFolderCalendar)
'  Set olConItems = olFolder.Items
  Set olAppointment = olApp.CreateItem(olAppointmentItem)

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

'  If rc = vbYes Then
'    Set olItem = olApp.CreateItem(olAppointmentItem)
    With olAppointment
      .MeetingStatus = olMeeting
      .Subject = selectedName & "の予定"
      .Body = "内容"
      .Start = #7/8/2025 9:00:00 AM#
      .End = #7/8/2025 10:00:00 AM#
      .Recipients.Add emailAddress
      .Save
    End With
'  End If
  MsgBox "予定が登録されました"
End Sub

必要な動きの部分だけでまずコードを作成してみるという方法は思いつきませんでした。
アドバイス大変勉強になりました。ありがとうございます。
この方法でまず希望通りの動きになるか試してみます。

日数が経過してしまいましたがこの間も試行錯誤で取り組んでいて、やっと自分の予定表ではなく希望の予定表に登録することができたのでOutlookの共有設定には問題がないことはわかりました。
アドバイス通り、アドレス、日程等決め打ちで余計な部分を削る形で、Set olItem = olConItems.Add()を追加して希望の予定表に登録することができたのですが、それを元に当初予定のユーザーフォームで選択した人のoutlook予定表に登録するコードを修正したのですがselectedNameのolFolder,olRec,olConItems等が入らないです。
 

Private Sub CommandButton1_Click()
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolder As Outlook.Folder
　 Dim olRec As Outlook.Recipient
    Dim olConItems As Outlook.Items
    Dim olItem As Outlook.AppointmentItem
    Dim rc As String
    Dim selectedName As String
    Dim emailAddress As String

    Const EMAIL_A As String = "〇〇@outlook.jp"
    Const EMAIL_B As String = "△△@outlook.jp"
    Const EMAIL_C As String = "□□@outlook.jp"
    
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then
        Set olApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
    
    selectedName = ComboBox1.Value
      
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olRec = olNamespace.CreateRecipient([color=red]selectedName[/color])
    [b]Set olFolder = olNamespace.GetShareDefaultFolder(olRec, olFolderCalendar)[/b]
    Set olConItems = olFolder.Items
    Set olAppointment = olApp.CreateItem(olAppointmentItem)
    
    Select Case selectedName
        Case "Aさん"
            emailAddress = EMAIL_A
        Case "Bさん"
            emailAddress = EMAIL_B
        Case "Cさん"
            emailAddress = EMAIL_C
        Case Else
            MsgBox "選択されたアドレスがありません"
            Exit Sub
    End Select
    
    rc = MsgBox("予定表へ登録しますか？", vbYesNo + vbQuestion, "確認")
    
    If rc = vbYes Then
        Set olItem = olConItems.Add()
          With olItem
             .Subject = Me.ComboBox2.Text & "の予定"
             .Body = Me.ComboBox2.Text
             .Start = Me.ComboBox3.Text & " " & Me.ComboBox4.Text
             .End = Me.ComboBox3.Text & " " & Me.ComboBox5.Text
             .Save
          End With
     End If
 End Sub

　式　　　　　　　　　値
EMAIL_A         "〇〇@outlook.jp"
EMAIL_B         "△△@outlook.jp"
EMAIL_C         "□□@outlook.jp"
Me
olAPP
olNameSpase
[color=red]olFolder          Nothing[/color]
rc                  ""
selectedName   "Aさん"
[color=red]olRec
olConItems     Nothing
olItem            Nothing
olCalenderItems    Empty値[/color]
            
 ユーザーフォームで選択した人（ComboBox1)をselectedNameに格納してる部分がうまく動かないようです。（※selectedNameではなくメールアドレスを直接入れると登録されます。） 
コードに何か足りないか順番がおかしいのか教えていただいたサイト等参考にしながら試行錯誤していましたがうまく行かず… アドバイスをお願いしたいです。      

引用:
ComboBox1 を selectedNameに格納している部分がうまく動かないようです。
(*selectedNameではなくメールアドレスを直接入れると登録されます)

引用:
アドレス、日程等決め打ちで余計な部分を削る形で、
Set olItem = olConItems.Add()を追加して希望の予定表に登録することができたのですが

    Select Case selectedName
        Case "Aさん"
            emailAddress = EMAIL_A
        Case "Bさん"
            emailAddress = EMAIL_B
        Case "Cさん"
            emailAddress = EMAIL_C
        Case Else
            MsgBox "選択されたアドレスがありません"
            Exit Sub
    End Select

推定した部分を踏まえ、コード全体の処理流れも考慮すると
以下の様なコードになるのかな。。
 

Private Sub CommandButton1_Click()
  Dim olApp As Outlook.Application
  Dim olNamespace As Outlook.Namespace
  Dim olFolder As Outlook.Folder
  Dim olRec As Outlook.Recipient
  Dim olConItems As Outlook.Items
  Dim olItem As Outlook.AppointmentItem
  Dim rc As Long 'String  MsoBoxの戻り値は、Long型
  Dim selectedName As String
  Dim emailAddress As String

  Const EMAIL_A As String = "〇〇@outlook.jp"
  Const EMAIL_B As String = "△△@outlook.jp"
  Const EMAIL_C As String = "□□@outlook.jp"
   
  '順番移動
    'ここの変数に何が入ってほしいのかにより
    '以下 Select Case 〜 End Select の処理内容変わる
  selectedName = Me.ComboBox1.Value
  Select Case selectedName
    Case "Aさん"
      emailAddress = EMAIL_A
    Case "Bさん"
      emailAddress = EMAIL_B
    Case "Cさん"
      emailAddress = EMAIL_C
    Case Else
      MsgBox "選択されたアドレスがありません"
      Exit Sub
  End Select


  '以前の流れだと、No だった場合
  '　・作成したオブジェクトは全て無駄になる
  '　・コードの途中でユーザーの反応を待つのは、好ましくない
  ' ので、先にユーザー反応を得てから オブジェクト生成を行う様にする
  rc = MsgBox("予定表へ登録しますか？", vbYesNo + vbQuestion, "確認")

  If rc = vbYes Then
  '順番移動ここまで

    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then
      Set olApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0


    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olRec = olNamespace.CreateRecipient(emailAddress)
    Set olFolder = olNamespace.GetShareDefaultFolder(olRec, olFolderCalendar)
    Set olConItems = olFolder.Items

' どこにも使っていないので不要、宣言もされていない
' Set olAppointment = olApp.CreateItem(olAppointmentItem)

    Set olItem = olConItems.Add()
    With olItem
      .Subject = Me.ComboBox2.Text & "の予定"
      .Body = Me.ComboBox2.Text
      .Start = Me.ComboBox3.Text & " " & Me.ComboBox4.Text
      .End = Me.ComboBox3.Text & " " & Me.ComboBox5.Text
      .Save
    End With
  End If
  '各オブジェクト変数後始末
  Set olItem = Nothing
  Set olConItems = Nothing
  Set olFolder = Nothing
  Set olRec = Nothing
  Set olNamespace = Nothing
  Set olApp = Nothing
End Sub

詳しいアドバイスいただきましてありがとうございます。
 

引用:
この登録することができたときの、selectedName には、何を渡していたのですか？
"Aさん"？ それとも、"〇〇@outlook.jp"？

引用:
ComboBox1 の「BoundColumn」プロパティーを『2』にすれば
Asan、Bsann を ComboBox1.Valueプロパティーにて取得する事が可能です。

引用:
「BoundColumn」を変える事により、コンボボックスの選択値から
直接 メールアドレスを取得できますから、Select Case 部分は不要になります。

無事に希望通り、ComboBoxで選択した人のOutlook予定表に予定を登録することができました！
共有設定になっているかどうかというところから確認方法等を教えていただき、その後も同じところをぐるぐると煮詰まって進まなかったのですが、こちらでアドバイスいただき本当に勉強になりました。
質問して良かったです。ありがとうございました。