none
ExcelVBAによるSkype for Business 2015(Microsoft Lync 2013)の操作方法 RRS feed

  • 質問

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

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

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

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

    Excel2013
    Windows7

    2016年7月8日 0:35

回答

  • 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) = "hoge@hoge.com"
        list(1) = "fuga@fuga.com"
        
        Invite list
    End Sub



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

    2016年7月10日 10:33

すべての返信

  • 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) = "hoge@hoge.com"
        list(1) = "fuga@fuga.com"
        
        Invite list
    End Sub



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

    2016年7月10日 10:33
  • gekka様

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

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

    ありがとうございます!

    2016年7月11日 5:39