Skip to content

Instantly share code, notes, and snippets.

  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
What would you like to do?
Outlookを使用してTeams会議の予定を作成するVBAマクロ 関連Tweet:
Option Explicit
'※ UIAutomationClient(UIAutomationCore.dll)要参照
' 参考:
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("必須出席者@*****").Type = olRequired
.Location = "Microsoft Teams 会議"
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
Set elmAppointmentTab = GetElement(uiAuto, elmRibbon, UIA_NamePropertyId, "予定", UIA_TabItemControlTypeId, TreeScope_Subtree)
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)
'Teams 会議ボタン反映待ち
Dim elmJoinMeetingButton As IUIAutomationElement
Set elmJoinMeetingButton = GetElement(uiAuto, elmRibbon, UIA_NamePropertyId, "Teams 会議に参加", UIA_ButtonControlTypeId, TreeScope_Subtree)
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment