Outlookを使用してTeams会議の予定を作成するVBAマクロ 関連Tweet：https://twitter.com/kinuasa/status/1455557297925623808

Outlookを使用してTeams会議の予定を作成するVBAマクロ.vb

Option Explicit

'Outlookを使用してTeams会議の予定を作成する
'※ UIAutomationClient(UIAutomationCore.dll)要参照
' 
' 参考： https://twitter.com/MasazaneKunohe/status/1455463463145275396
' 
Public Sub CreateTeamsMeetingUsingOutlook()
  Dim appOutlook As Object 'Outlook.Application
  Set appOutlook = CreateObject("Outlook.Application")
  
  '会議作成
  '※ 必要に応じて値設定
  Dim itm As Object 'Outlook.AppointmentItem
  Dim inspAppointment As Object 'Outlook.Inspector
  Const olAppointmentItem = 1
  Const olRequired = 1
  Set itm = appOutlook.CreateItem(olAppointmentItem)
  With itm
    .Subject = "テスト会議"
    .Recipients.Add("必須出席者@*****.onmicrosoft.com").Type = olRequired
    .Location = "Microsoft Teams 会議"
    .Display
    Set inspAppointment = .GetInspector
  End With
  
  Dim uiAuto As CUIAutomation
  Set uiAuto = New CUIAutomation
  Dim elmRibbon As IUIAutomationElement
  Set elmRibbon = uiAuto.ElementFromIAccessible(inspAppointment.CommandBars("Ribbon"), 0)
  '「予定」タブを選択
  Dim elmAppointmentTab As IUIAutomationElement
  Do
    Set elmAppointmentTab = GetElement(uiAuto, elmRibbon, UIA_NamePropertyId, "予定", UIA_TabItemControlTypeId, TreeScope_Subtree)
    DoEvents
  Loop While elmAppointmentTab Is Nothing
  Dim selptn As IUIAutomationSelectionItemPattern
  Set selptn = elmAppointmentTab.GetCurrentPattern(UIA_SelectionItemPatternId)
  If selptn.CurrentIsSelected = False Then selptn.Select
  
  '「Teams 会議」ボタンをクリック
  Dim elmTeamsMeetingButton As IUIAutomationElement
  Set elmTeamsMeetingButton = GetElement(uiAuto, elmRibbon, UIA_NamePropertyId, "Teams 会議", UIA_ButtonControlTypeId, TreeScope_Subtree)
  If elmTeamsMeetingButton Is Nothing Then Exit Sub
  Dim iptn As IUIAutomationInvokePattern
  Set iptn = elmTeamsMeetingButton.GetCurrentPattern(UIA_InvokePatternId)
  iptn.Invoke
  'Teams 会議ボタン反映待ち
  Dim elmJoinMeetingButton As IUIAutomationElement
  Do
    Set elmJoinMeetingButton = GetElement(uiAuto, elmRibbon, UIA_NamePropertyId, "Teams 会議に参加", UIA_ButtonControlTypeId, TreeScope_Subtree)
    DoEvents
  Loop While elmJoinMeetingButton Is Nothing
  
  Const olSave = 0
  itm.Close olSave '保存して閉じる
  CreateObject("Shell.Application").ShellExecute "OUTLOOK.EXE" 'Outlook起動(確認用)
End Sub

Private Function GetElement(ByVal uiAuto As CUIAutomation, _
                            ByVal elmParent As IUIAutomationElement, _
                            ByVal propertyId As Long, _
                            ByVal propertyValue As Variant, _
                            Optional ByVal ctrlType As Long = 0, _
                            Optional ByVal scope As TreeScope = TreeScope.TreeScope_Subtree) As IUIAutomationElement
  Dim cndFirst As IUIAutomationCondition
  Dim cndSecond As IUIAutomationCondition
     
  Set cndFirst = uiAuto.CreatePropertyCondition( _
                   propertyId, _
                   propertyValue _
                 )
  If ctrlType <> 0 Then
    Set cndSecond = uiAuto.CreatePropertyCondition( _
                      UIA_ControlTypePropertyId, _
                      ctrlType _
                    )
    Set cndFirst = uiAuto.CreateAndCondition( _
                     cndFirst, _
                     cndSecond _
                   )
  End If
  Set GetElement = elmParent.FindFirst(scope, cndFirst)
End Function