ExcelVBAによるSkype for Business 2015（Microsoft Lync 2013）の操作方法

Question

ExcelVBAでSkype for Businessにおける会話のメンバー登録を自動化したいのですが、ExcelVBA（Excel2013）で操作できないでしょうか。

イメージとしてはファイルサーバーの共有フォルダにある、会話登録する人のリスト（Excel）を作っておき、マクロ実行によって会話に招待し、適当な第一声をかけて、各人のＰＣにも会話を表示させたいと考えています。

色々調べたのですが、ExcelVBAでSkype for Businessを操作するということに関して見当たらないため、できないのかもしれませんが。

よろしくお願いいたします。

Excel2013
Windows7

Answer 1

UIAutomationを使えばできないこともないかも
#じっさいに招待まで出来るかは確認できてません

Option Explicit

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowW" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function SendMessage Lib "User32.dll" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As String) As LongPtr
Private Const WM_SETTEXT = &HC

Private hwndLync As LongPtr

Private Function FindLyncWindow(ByVal uia As UIAutomationClient.CUIAutomation) As UIAutomationClient.IUIAutomationElement
    Set FindLyncWindow = Nothing
    If (hwndLync <> 0) Then
        On Error Resume Next
        Set FindLyncWindow = uia.ElementFromHandle(hwndLync)
        If (Err.Number = 0) Then
            Exit Function
        End If
        On Error GoTo 0
        hwndLync = 0
    End If
    
    Dim hDesktop As LongPtr
    Dim elemDesktop As UIAutomationClient.IUIAutomationElement
    Dim ar As UIAutomationClient.IUIAutomationElementArray
    Dim pcon As UIAutomationClient.IUIAutomationPropertyCondition
    Dim elemLyncWindow As UIAutomationClient.IUIAutomationElement
    Dim windowTitle As String
        
    hDesktop = GetDesktopWindow()
    Set elemDesktop = uia.ElementFromHandle(ByVal hDesktop)
    Set pcon = uia.CreatePropertyCondition(UIAutomationClient.UIA_ClassNamePropertyId, "LyncConversationWindowClass")
    Set ar = elemDesktop.FindAll(TreeScope_Children, pcon)
    Set elemDesktop = Nothing
    Set pcon = Nothing
    
    If (ar.Length <> 0) Then
        Set elemLyncWindow = ar.GetElement(0)
        windowTitle = elemLyncWindow.GetCurrentPropertyValue(UIA_NamePropertyId)
        hwndLync = FindWindow(vbNullString, windowTitle)
        
        Set FindLyncWindow = elemLyncWindow
    End If
    
End Function

Private Function FindElementFrom _
    (ByVal uia As UIAutomationClient.CUIAutomation _
    , ByVal elemLyncWindow As UIAutomationClient.IUIAutomationElement _
    , ByVal name As String _
    , controlTypeID As Variant) As UIAutomationClient.IUIAutomationElement
    
    Dim conAnd As UIAutomationClient.IUIAutomationAndCondition
    Dim conControl As UIAutomationClient.IUIAutomationPropertyCondition
    Dim conNameOrTel As UIAutomationClient.IUIAutomationPropertyCondition
    Dim elemNameOrTel As UIAutomationClient.IUIAutomationElement
    
    Set conNameOrTel = uia.CreatePropertyCondition(UIA_NamePropertyId, name)
    Set conControl = uia.CreatePropertyCondition(UIA_ControlTypePropertyId, controlTypeID)
    Set conAnd = uia.CreateAndCondition(conControl, conNameOrTel)
    Set FindElementFrom = elemLyncWindow.FindFirst(TreeScope_Subtree, conAnd)
End Function

Private Function FindInviteDialog(ByVal uia As UIAutomationClient.CUIAutomation, ByVal elemLyncWindow As UIAutomationClient.IUIAutomationElement) As UIAutomationClient.IUIAutomationElement
    Set FindInviteDialog = FindElementFrom(uia, elemLyncWindow, "名前または電話番号で招待", UIA_CustomControlTypeId)
End Function

Private Function FindNameOrTelEdit(ByVal uia As UIAutomationClient.CUIAutomation, ByVal elemInviteDialog As UIAutomationClient.IUIAutomationElement) As UIAutomationClient.IUIAutomationElement
    Set FindNameOrTelEdit = FindElementFrom(uia, elemInviteDialog, "リストから連絡先を選択するか、名前または電話番号を入力してください", UIA_EditControlTypeId)
End Function
Private Function FindOKButton(ByVal uia As UIAutomationClient.CUIAutomation, ByVal elemInviteDialog As UIAutomationClient.IUIAutomationElement) As UIAutomationClient.IUIAutomationElement
    Set FindOKButton = FindElementFrom(uia, elemInviteDialog, "OK", UIA_ButtonControlTypeId)

End Function
Private Function FindCancelButton(ByVal uia As UIAutomationClient.CUIAutomation, ByVal elemInviteDialog As UIAutomationClient.IUIAutomationElement) As UIAutomationClient.IUIAutomationElement
    Set FindCancelButton = FindElementFrom(uia, elemInviteDialog, "キャンセル", UIA_ButtonControlTypeId)
End Function


Private Function SetText(ByVal elem As UIAutomationClient.IUIAutomationElement, ByVal text As String) As Boolean
    Call elem.SetFocus
    
    Dim patValue As UIAutomationClient.IUIAutomationValuePattern
    Set patValue = elem.GetCurrentPattern(UIA_ValuePatternId)
    'patValue.SetValue (text)'UIAutomationでの文字列受付をしてくれない…
    If (patValue.CurrentValue = text) Then
        SetText = True
    Else
        Dim a As Variant
        a = elem.GetRuntimeId()
        Dim hwndEdit As LongPtr
        hwndEdit = a(1)
        Debug.Print Hex(hwndEdit)
        Call SendMessage(hwndEdit, WM_SETTEXT, 0, text)
        If (patValue.CurrentValue = text) Then
            SetText = True
        Else
            SetText = False
            MsgBox "文字列を設定できませんでした"
        End If
    End If

End Function

Private Function WaitEnable(ByVal elem As UIAutomationClient.IUIAutomationElement) As Boolean
    Dim isEnableOK As Boolean
    Dim t As Date
    t = Now + TimeValue("0:0:5") '有効になるまでとりあえず5秒ぐらいまってみる
    
    Do While (t > Now)
        isEnableOK = elem.GetCurrentPropertyValue(UIA_IsEnabledPropertyId)
        If (isEnableOK) Then
            Exit Do
        End If
    Loop
    WaitEnable = isEnableOK
End Function

Private Sub Invite(ByRef list() As String)

    Dim uia As New UIAutomationClient.CUIAutomation
    Dim elemLyncWindow As UIAutomationClient.IUIAutomationElement
    Dim elemInviteMemberButton As UIAutomationClient.IUIAutomationElement
    Dim elemInviteDialog As UIAutomationClient.IUIAutomationElement
    Dim elemNameOrTel As UIAutomationClient.IUIAutomationElement
    Dim elemOK As UIAutomationClient.IUIAutomationElement
    Dim elemCancel As UIAutomationClient.IUIAutomationElement
    
    Dim ar As UIAutomationClient.IUIAutomationElementArray
    Dim conInviteMember As UIAutomationClient.IUIAutomationPropertyCondition
    Dim patInvoke As UIAutomationClient.IUIAutomationInvokePattern
    Dim patInvokeButton As UIAutomationClient.IUIAutomationInvokePattern
    
    Set elemLyncWindow = FindLyncWindow(uia)
    If (elemLyncWindow Is Nothing) Then
        MsgBox "Skype(Lync)が見つかりませんでした"
        Exit Sub
    End If

    Set conInviteMember = uia.CreatePropertyCondition(UIAutomationClient.UIA_NamePropertyId, "他の参加者を招待します")
    Set ar = elemLyncWindow.FindAll(TreeScope_Subtree, conInviteMember)
    If (ar Is Nothing) Then
        MsgBox "参加者招待ボタンが見つかりませんでした"
        Exit Sub
    ElseIf (ar.Length = 0) Then
        MsgBox "参加者招待ボタンが見つかりませんでした"
        Exit Sub
    ElseIf (ar.Length >= 2) Then
        MsgBox "参加者招待ボタンが複数見つかりました。"
        Exit Sub
    End If

    Set elemInviteMemberButton = ar.GetElement(0)
    
    
    Dim i As Integer
    For i = 0 To UBound(list)
   
        Dim member As String
        member = list(i)
        If (Not WaitEnable(elemInviteMemberButton)) Then
            MsgBox "参加者招待ボタンが無効です"
            Exit For
        End If
        Set patInvoke = elemInviteMemberButton.GetCurrentPattern(UIA_InvokePatternId)
        Call patInvoke.Invoke
        Set elemInviteDialog = FindInviteDialog(uia, elemLyncWindow)
        Set elemNameOrTel = FindNameOrTelEdit(uia, elemInviteDialog)
        Set elemOK = FindOKButton(uia, elemInviteDialog)
        Set elemCancel = FindCancelButton(uia, elemInviteDialog)

        Call SetText(elemNameOrTel, member)
    
        If (Not WaitEnable(elemOK)) Then
            MsgBox "追加を行えませんでした"
            Set patInvokeButton = elemCancel.GetCurrentPattern(UIA_InvokePatternId)
            Exit For
        Else
            Set patInvokeButton = elemOK.GetCurrentPattern(UIA_InvokePatternId)
        End If
        Call patInvokeButton.Invoke
    Next
End Sub

'Skypeを起動して会議のウィンドウを1つだけ表示されている状態で実行する
Public Sub AddMember()
    Dim list(1) As String
    list(0) = "[e-mail]"
    list(1) = "[e-mail]"
    
    Invite list
End Sub

---

個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

Answer 2

gekka様

ご回答ありがとうございます！
なるほど、UIの操作からやってしまうのですね！
同じMicrosoftなんだから簡単にできるのでは？と思っていましたが甘く見てました。。

提示していただいたコードを解読してやってみます！

ありがとうございます！