くのへスタジオ こんにちは、くのへ@MasazaneKunoheです。
ノンプロ研で大変お世話になっているkmkさんからこんなご相談頂きました。
ただの会議設定なら、こちらの記事のコードで実装できますが、Teams会議、、、だと！？
色々トライして実装しましたのでコードを紹介します。
Teams会議を設定
本コードを実行するためには、Microsoft Teamsがインストールされており、Outlookの会議のウィンドウにTeamsのアイコンが出ていることが前提にしています。
コード
Excel VBEの標準モジュールに次のコードをコピペで動くと思います。
ただし
①Outlook Object Libraryの参照設定は行ってください。
②Sleep関数を使うための呪文はOption Explicitの直後に記載ください。
（最初の５行くらい#IF～#End IFのコード）
Option Explicit
'Sleep関数を使用するための設定
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If
Sub Teams会議()
'Outlook Object Libraryの参照設定を行うこと
Dim appOL As Object
Set appOL = New Outlook.Application
Dim objItem As Object
Set objItem = appOL.CreateItem(olAppointmentItem)
With objItem
'会議アイテム化
.MeetingStatus = olMeeting
'表示
.Display
'必須出席者
.Recipients.Add ("AAA@sample.com")
.Recipients("AAA@sample.com").Type = olRequired
'任意出席者
.Recipients.Add ("BBB@sample.com")
.Recipients("BBB@sample.com").Type = olOptional
'リソース
' .Recipients.Add ("CCC@sample.com")
' .Recipients("CCC@sample.com").Type =olResource
'日時設定
.Start = "2021/11/3 9:00"
.End = "2021/11/3 10:00"
'件名・本文
.Subject = "件名"
.Body = "本文"
'非公開設定
.Sensitivity = olPrivate
'Teams会議設定
Application.SendKeys ("%H")
Application.SendKeys ("TM")
'Teams会議が反映されるまでウェイトを設ける。不安定ならば時間を延ばすこと。
Sleep 100 '100ミリ秒のウェイト
'下書き保存
.Save
'閉じる（閉じない場合はコメントアウトすべし）
.Close (olDiscard)
End With
End Sub
ポイント解説
次の黄色マーク部です。他のコードについてはこちらの記事を参照ください。
Option Explicit
'Sleep関数を使用するための設定
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If
Sub Teams会議()
'Outlook Object Libraryの参照設定を行うこと
Dim appOL As Object
Set appOL = New Outlook.Application
Dim objItem As Object
Set objItem = appOL.CreateItem(olAppointmentItem)
With objItem
'会議アイテム化
.MeetingStatus = olMeeting
'表示
.Display
'必須出席者
.Recipients.Add ("AAA@sample.com")
.Recipients("AAA@sample.com").Type = olRequired
'任意出席者
.Recipients.Add ("BBB@sample.com")
.Recipients("BBB@sample.com").Type = olOptional
'リソース
' .Recipients.Add ("CCC@sample.com")
' .Recipients("CCC@sample.com").Type =olResource
'日時設定
.Start = "2021/11/3 9:00"
.End = "2021/11/3 10:00"
'件名・本文
.Subject = "件名"
.Body = "本文"
'非公開設定
.Sensitivity = olPrivate
'Teams会議設定
Application.SendKeys ("%H")
Application.SendKeys ("TM")
'Teams会議が反映されるまでウェイトを設ける。不安定ならば時間を延ばすこと。
Sleep 100 '100ミリ秒のウェイト
'下書き保存
.Save
'閉じる（閉じない場合はコメントアウトすべし）
.Close (olDiscard)
End With
End Sub
Teams会議を設定するためにはここを押す必要があります。
ここを押す作業を、キーボードで実行するためには、Alt + H、T、Mの順に押せばＯＫです。
これをVBAでそのままSendKeysで模擬しました。
Sendkeysは以下書式です。
Application.Sendkeys (キー名）ただし、Altは「%」と書く必要があります。MicroSoft社の公式Docsにて相関表が書いてあります（こちら）。
Sendkeysは実際にキーボード操作を押した状態をシミュレートできるので便利です。
ただし、人間の場合はキーボード処理の結果を無意識のうちに待ってから次の操作を行いますが、プログラミングで実装すると処理の結果を待たずに次の処理を開始してしまいます。
そのためバグが生まれやすくなってしまいます。
実際、このコードも動作がやや不安定で、Teams会議を設定する前に保存して閉じられてしまう事があります。
そこで、今回はSleep関数を用いて、100ミリ秒待つ処理を加えました。
これでも動作が不安定であれば、200ミリ秒などに変更して調整が必要です。
（そのため、これはあまり優れているコードではありません💦）
Outlook VBEにて実装しようとすると、、、
Outlook VBEに類似コードを記載して実行してみたところ、このコードは不安定で使用に耐えないことが分かりました。
この原因は不明ですが、VBE上で実行するとTeams会議が設定されるものの、開発タブのマクロの実行から実行してみるとTeams会議が設定されなかったり、Bodyに書き込むとTeams会議が設定されなかったり、、、と実用には堪えませんでした。
きぬあささんがすごいコードを作られています
この話題の時に、きぬあささんがUIAutomateを用いて実装されています。
このGitHubにてコードが公開されており、私も実行してみたところ、うまく動くことを確認しています。きぬあささん流石すぎる！！！
ではまた別の記事で～
🦅バサバサ～
