その他

【簡単！UIAutomation利用】VBAツールで画面操作して自動ログインする[No88]

スポンサーリンク

毎日のように、複数環境にログインして作業しているシステムがあります。

本番環境、開発環境のように環境ごとにホスト名、ユーザ名、パスワードが異なるため、これまでは手作業で切り替えて利用していました。

そこで、ほとんど１クリックでログイン情報を自動入力し、ログインできるようにしてみました。

また、ログインに用いる情報については、ツール内部には記載するとセキュリティ面が心配なため、別の場所にあるファイルを参照するようにしました。

利用環境

この自動化はウィンドウハンドル（Window Handle）の情報があれば、どのソフトウェアでも応用が利き、利用可能です。

今回はホスト名、ユーザ名、パスワードの入力を求められるソフトの一例として、次のアプリを使用しました。

  • OS：Windows 10
  • WinSCP：バージョン5.19.6

準備

「 "C:\" 」に「AutoLogin」フォルダを作成し、次の４つのファイルをそのフォルダに入れます。

  • 自動ログイン_WinSCP.xlsm
  • MainFileName.txt
  • RunExcelFile.vbs
  • 接続情報.txt

また、WinSCPもインストールしておきます。
保存場所は「 "C:\Program Files (x86)\WinSCP\WinSCP.exe" 」になるようにします。

コード

VBAの参照設定で、参照可能なライブラリから「UIAutomationClient」を選択しておきましょう。

自動ログイン_WinSCP.xlsm　モジュール名：ThisWorkBook


Option Explicit

Private Const DPI As Long = 96
Private Const PPI As Long = 72

Private Const THISWORK_TOP      As Long = 40
Private Const THISWORK_LEFT     As Long = 0
Private Const THISWORK_WIDTH    As Long = 500
Private Const THISWORK_HEIGHT   As Long = 500

Public Function FromPixelToPoint(ByVal pixel As Long) As Long
    FromPixelToPoint = pixel * PPI / DPI
End Function

Private Sub Workbook_Open()
    With Application
        .WindowState = xlNormal
        
        .Top = FromPixelToPoint(THISWORK_TOP)
        .Left = FromPixelToPoint(THISWORK_LEFT)
        
        .Width = FromPixelToPoint(THISWORK_WIDTH)
        .Height = FromPixelToPoint(THISWORK_HEIGHT)
        
    End With
End Sub

自動ログイン_WinSCP.xlsm　モジュール名：mdAPP


Option Explicit

Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As LongPtr

Declare PtrSafe Function ShowWindow Lib "user32" ( _
    ByVal hwnd As LongPtr, _
    ByVal nCmdShow As Long) As Long

Const SW_HIDE = 0
Const SW_SHOWNORMAL = 1
Const APPEXEFILEPATH As String = "C:\Program Files (x86)\WinSCP\WinSCP.exe"

Public Sub RunAppMainAccount01()
    Dim dRow As Long
    dRow = 0
    Call RunAppMain(dRow)
End Sub

Public Sub RunAppMainAccount02()
    Dim dRow As Long
    dRow = 1
    Call RunAppMain(dRow)
End Sub

Public Sub RunAppMainAccount03()
    Dim dRow As Long
    dRow = 2
    Call RunAppMain(dRow)
End Sub

Public Sub RunAppMain(ByVal dRow As Long)

    Dim handleParent As Long
    Dim handlechild As Long
    Dim className As String
    Dim windowTitleName As String
    
    '**********************
    Dim FileName As String
    FileName = "接続情報.txt"
    
    Dim readFilePath As String
    readFilePath = ThisWorkbook.Path & "\" & FileName
    
    Dim arr As Variant
    arr = ReadCSVFile(readFilePath)
    
    '**********************
    '(dRow+1)行目のデータを取得
    Dim HOST As String: HOST = arr(dRow, 0)
    Dim USER As String: USER = arr(dRow, 1)
    Dim PASS As String: PASS = arr(dRow, 2)
    '**********************
    
    Call RunApp(APPEXEFILEPATH)
    
    timeWait ("00:00:05")
     
    Dim hwnd As LongPtr
    hwnd = FindWindow(vbNullString, "WinSCP")
    Call LogInApp(hwnd, HOST, USER, PASS)
    
    Exit Sub
ErrEnd:
    MsgBox "実行できませんでした。" & vbCrLf & "エラー内容：" & Err.Description
End Sub

Private Sub LogInApp(ByVal hwnd As LongPtr, HOST As String, USER As String, PASS As String)
    Dim uiAuto As CUIAutomation: Set uiAuto = New CUIAutomation
    Dim uiElm As IUIAutomationElement
    Dim uiCnd As IUIAutomationCondition
    Dim uiValue As IUIAutomationValuePattern
    Dim uiInvoke As IUIAutomationInvokePattern
    
    Dim tempHwnd As LongPtr
    Dim arrayUiElms01 As IUIAutomationElementArray
    Dim arrayUiElms02 As IUIAutomationElementArray
    
    Dim intI As Long
    Dim intII As Long
    
    '************************************************************************************
    '【ホスト名、ユーザ名、パスワードをセットする】
    
    '①：ウィンドウハンドルからエレメントを取得
    Set uiElm = uiAuto.ElementFromHandle(ByVal hwnd)
    
    '②：ログインウィンドウのエレメントを取得
    Set uiCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "TLoginDialog")
    Set uiElm = uiElm.FindFirst(TreeScope_Children, uiCnd)

    '③：エレメントを取得　'Class名とNameが同じため、それぞれの下のエレメントを確認し判別
    Set uiCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "TPanel")
    Set arrayUiElms01 = uiElm.FindAll(TreeScope_Children, uiCnd)
    
    For intI = 0 To arrayUiElms01.Length - 1
        Debug.Print "For01 : intI" & ":" & intI
        
        Set uiElm = arrayUiElms01.GetElement(intI)
        If uiElm Is Nothing Then
            Debug.Print "③" & "(" & intI & ")" & "：" & "uiElm → Nothing"
        Else
            tempHwnd = uiElm.GetCurrentPropertyValue(UIA_NativeWindowHandlePropertyId)
            Debug.Print "③" & "(" & intI & ")" & "：" & tempHwnd
        End If
        
        '④：エレメントを取得
        Set uiCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "TPanel")
        
        Set arrayUiElms02 = uiElm.FindAll(TreeScope_Children, uiCnd)
        
        For intII = 0 To arrayUiElms02.Length - 1
            Debug.Print "For02 : intI" & ":" & intI & "|||" & "intII" & ":" & intII
            
            Set uiElm = arrayUiElms02.GetElement(intII)
            If uiElm Is Nothing Then
                Debug.Print "④" & "(" & intII & ")" & "：" & "uiElm → Nothing"
            Else
                tempHwnd = uiElm.GetCurrentPropertyValue(UIA_NativeWindowHandlePropertyId)
                Debug.Print "④" & "(" & intII & ")" & "：" & tempHwnd
            End If
        
            '⑤：エレメントを取得
            Set uiCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "TGroupBox")
            Set uiElm = uiElm.FindFirst(TreeScope_Children, uiCnd)
            
            If uiElm Is Nothing Then
                Debug.Print "⑤" & "(" & intII & ")" & "：" & "uiElm → Nothing"
            Else
                tempHwnd = uiElm.GetCurrentPropertyValue(UIA_NativeWindowHandlePropertyId)
                Debug.Print "⑤" & "(" & intII & ")" & "：" & tempHwnd
                
                If (StrComp(uiElm.CurrentClassName, "TGroupBox", vbTextCompare) = 0) Then
                    Exit For
                End If
            End If
        Next
    Next

    If uiElm Is Nothing Then
    Else
        'tempHwnd = uiElm.GetCurrentPropertyValue(UIA_NativeWindowHandlePropertyId): Call Flash(tempHwnd)
        
        '⑥：HOSTのエレメントを取得の準備
        Dim uiCndHOST As IUIAutomationCondition
        Set uiCndHOST = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "TEdit")
        
        Dim uiElmHOST As IUIAutomationElement
        Set uiElmHOST = uiElm.FindAll(TreeScope_Children, uiCndHOST).GetElement(1)
        
        '⑥：USERのエレメントを取得の準備
        Dim uiCndUSER As IUIAutomationCondition
        Set uiCndUSER = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "TEdit")
        
        Dim uiElmUSER As IUIAutomationElement
        Set uiElmUSER = uiElm.FindAll(TreeScope_Children, uiCndUSER).GetElement(0)
        
        '⑥：PASSのエレメントを取得の準備
        Dim uiCndPASS As IUIAutomationCondition
        Set uiCndPASS = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "TPasswordEdit")
        
        Dim uiElmPASS As IUIAutomationElement
        Set uiElmPASS = uiElm.FindFirst(TreeScope_Children, uiCndPASS)
        
        'tempHwnd = uiElmHOST.GetCurrentPropertyValue(UIA_NativeWindowHandlePropertyId): Call Flash(tempHwnd)
        'tempHwnd = uiElmUSER.GetCurrentPropertyValue(UIA_NativeWindowHandlePropertyId): Call Flash(tempHwnd)
        'tempHwnd = uiElmPASS.GetCurrentPropertyValue(UIA_NativeWindowHandlePropertyId): Call Flash(tempHwnd)
        
        Set uiValue = uiElmHOST.GetCurrentPattern(UIA_ValuePatternId): uiValue.SetValue HOST
        Set uiValue = uiElmUSER.GetCurrentPattern(UIA_ValuePatternId): uiValue.SetValue USER
        Set uiValue = uiElmPASS.GetCurrentPattern(UIA_ValuePatternId): uiValue.SetValue PASS
    End If
    
    '************************************************************************************
    '【ログインボタンを押す】
    
    timeWait ("00:00:05")
    
    '①：ウィンドウハンドルからエレメントを取得
    Set uiElm = uiAuto.ElementFromHandle(ByVal hwnd)
    
    '②：ログインウィンドウのエレメントを取得
    Set uiCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "TLoginDialog")
    Set uiElm = uiElm.FindFirst(TreeScope_Children, uiCnd)

    '③：エレメントを取得　'Class名とNameが同じため、それぞれの下のエレメントを確認し判別
    Set uiCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "TPanel")
    Set arrayUiElms01 = uiElm.FindAll(TreeScope_Children, uiCnd)
    
    For intI = 0 To arrayUiElms01.Length - 1
        Debug.Print "For01 : intI" & ":" & intI
        
        Set uiElm = arrayUiElms01.GetElement(intI)
        If uiElm Is Nothing Then
            Debug.Print "③" & "(" & intI & ")" & "：" & "uiElm → Nothing"
        Else
            tempHwnd = uiElm.GetCurrentPropertyValue(UIA_NativeWindowHandlePropertyId)
            Debug.Print "③" & "(" & intI & ")" & "：" & tempHwnd
        End If
        
        '⑦：エレメントを取得
        Set uiCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "TPanel")
        
        Set arrayUiElms02 = uiElm.FindAll(TreeScope_Children, uiCnd)
        
        For intII = 0 To arrayUiElms02.Length - 1
            Debug.Print "For02 : intI" & ":" & intI & "|||" & "intII" & ":" & intII
            
            Set uiElm = arrayUiElms02.GetElement(intII)
            If uiElm Is Nothing Then
                Debug.Print "⑦" & "(" & intII & ")" & "：" & "uiElm → Nothing"
            Else
                tempHwnd = uiElm.GetCurrentPropertyValue(UIA_NativeWindowHandlePropertyId)
                Debug.Print "⑦" & "(" & intII & ")" & "：" & tempHwnd
            End If
        
            '⑧：エレメントを取得
            'Set uiCnd = uiAuto.CreatePropertyCondition(UIA_NamePropertyId, "      ログイン")
            'Set uiElm = uiElm.FindFirst(TreeScope_Children, uiCnd)
            
            Set uiCnd = uiAuto.CreatePropertyCondition(UIA_NamePropertyId, "閉じる")
            Set uiElm = uiElm.FindFirst(TreeScope_Children, uiCnd)
            
            If uiElm Is Nothing Then
                Debug.Print "⑧" & "(" & intII & ")" & "：" & "uiElm → Nothing"
            Else
                tempHwnd = uiElm.GetCurrentPropertyValue(UIA_NativeWindowHandlePropertyId)
                Debug.Print "⑧" & "(" & intII & ")" & "：" & tempHwnd
                
                'If (StrComp(uiElm.CurrentName, "      ログイン", vbTextCompare) = 0) Then
                '    Exit For
                'End If
                If (StrComp(uiElm.CurrentName, "閉じる", vbTextCompare) = 0) Then
                    Exit For
                End If
            End If
        Next
    Next
    
    If uiElm Is Nothing Then
    Else
        '⑨：エレメントをクリック
        Dim uiElmLOGIN As IUIAutomationElement
        Set uiElmLOGIN = uiElm
        
        'tempHwnd = uiElmLOGIN.GetCurrentPropertyValue(UIA_NativeWindowHandlePropertyId): Call Flash(tempHwnd)
        Set uiInvoke = uiElmLOGIN.GetCurrentPattern(UIA_InvokePatternId)
        uiInvoke.Invoke
    End If
    
    '************************************************************************************

    Application.DisplayAlerts = False
    
    If Workbooks.Count > 1 Then
        ThisWorkbook.Close SaveChanges:=False
    Else
        Application.Quit
    End If

    Application.DisplayAlerts = True

End Sub

Private Sub RunApp(ByVal runExeFilePath As String)
    'On Error GoTo ErrEnd
        Dim ret As Long
        ret = Shell(runExeFilePath, vbNormalFocus)
    'On Error GoTo 0
End Sub

Private Sub Flash(ByVal Handle As LongPtr)
        ShowWindow Handle, SW_HIDE
        timeWait ("00:00:01")
        ShowWindow Handle, SW_SHOWNORMAL
        timeWait ("00:00:01")
        ShowWindow Handle, SW_HIDE
        timeWait ("00:00:01")
        ShowWindow Handle, SW_SHOWNORMAL
End Sub

自動ログイン_WinSCP.xlsm　モジュール名：md00SubFunction


Option Explicit

Public Sub timeWait(ByVal myTime As String)
    Dim waitTime As Date
    waitTime = Now + TimeValue(myTime)

    DoEvents
    Application.Wait waitTime
    DoEvents
End Sub

Public Function ReadCSVFile(ByVal readFilePath As String) As Variant
    Dim n As Long
    
    Dim stringText As String
    Dim tmp As Variant
    '-------------------------------------------------------------
    Dim cntx As Long
    Dim cnty As Long
    Dim cntyMax As Long
    
    n = FreeFile(0)
    Open readFilePath For Input As #n
        Do Until EOF(n)
            Line Input #n, stringText
            cntx = cntx + 1
            
            tmp = Split(stringText, ",")
            cnty = UBound(tmp)
            
            If cntyMax <= cnty Then cntyMax = cnty
        Loop
    Close #n
    '-------------------------------------------------------------
    Dim x As Long
    Dim y As Long
    Dim arr As Variant
    ReDim arr(cntx - 1, cntyMax) As Variant

    n = FreeFile(0)
    Open readFilePath For Input As #n
        Do Until EOF(n)
            Line Input #n, stringText
            
            tmp = Split(stringText, ",")
            
            For y = 0 To UBound(tmp, 1)
                arr(x, y) = tmp(y)
            Next
            
            x = x + 1
        Loop
    Close #n
    '-------------------------------------------------------------
    ReadCSVFile = arr

    Exit Function
ReadError:
    Close #n
    MsgBox "読み込みに失敗しました。"
End Function

スポンサーリンク

MainFileName.txt

注意：ファイルの文字コードは「SJIS」にしておきます。メモ帳で保存する際は「ANIS」になっているようにしましょう。


自動ログイン_WinSCP.xlsm

RunExcelFile.vbs

注意：ファイルの文字コードは「SJIS」にしておきます。メモ帳で保存する際は「ANIS」になっているようにしましょう。


Option Explicit

'*********************************************************
'用途: 自動ダウンロードのファイル名を取得
'*********************************************************
Dim obj99
Set obj99 = WScript.CreateObject("Scripting.FileSystemObject")

Dim MainFileNamePath 
    MainFileNamePath = "C:\AutoLogin\MainFileName.txt"
'Set MainFileNamePath = CreateObject("Scripting.FileSystemObject").GetFolder(".")

Dim mainFile
Set mainFile = obj99.OpenTextFile(MainFileNamePath)

DIm fileName
    fileName = mainFile.ReadLine

mainFile.Close

'*********************************************************
'用途: メイン呼び出し
'*********************************************************
On Error Resume Next
Dim obj
Set obj = CreateObject("Excel.Application")
On Error Goto 0

'ファイル場所とファイル名とマクロ名
Dim filePath
filePath  = "C:\AutoLogin\" & fileName
'Set filePath = CreateObject("Scripting.FileSystemObject").GetFolder(".")

Dim macroName :macroName = "RunAppMainAccount01"
'Dim macroName :macroName = "RunAppMainAccount02"
'Dim macroName :macroName = "RunAppMainAccount03"

Dim excelMacro
excelMacro = fileName & "!" & macroName

On Error Resume Next
obj.Visible = True

BringToFront obj

Dim xlWorkbook
Set xlWorkbook = obj.Workbooks.Open(filePath)

On Error Goto 0

Call runMacro(obj,xlWorkbook)

'*********************************************************
'用途: マクロを実行
'*********************************************************
Sub runMacro(ByVal obj,ByVal xwk)
	
	'引数2がNullであれば何もしない
	If IsNull(xwk) = True then
		xwk = "Do Nothing"
	End If
	
	On Error Resume Next
	obj.Run excelMacro
	If Err.Number <> 0 Then
		'MsgBox "予期しないエラーが発生しました。" & vbCrLf & _
        '    "エラー番号：" & Err.Number & vbCrLf & _
        '    "エラー詳細：" & Err.Description
        
		'引数2がNull以外の時：Excelを閉じる
        If IsNull(xwk) = False then
        	xwk.Close
        	If obj.Workbooks.Count = 0 then
        		obj.Quit
        	End If
		End If
		WScript.Echo "エラー例：ファイルにマクロ「" & excelMacro & "」が登録されていない。"
        
        Set obj = Nothing
		WScript.Quit
	End If
	Err.Clear
	On Error Goto 0
End Sub

'*********************************************************
'用途: 最前面に表示
'*********************************************************
Sub BringToFront(ByVal obj)
	On Error Resume Next
	'最前面に表示
	CreateObject("WScript.Shell").AppActivate obj.Caption
	On Error Goto 0

	Set obj = Nothing
End Sub

接続情報.txt

注意：ファイルの文字コードは「SJIS」にしておきます。メモ帳で保存する際は「ANIS」になっているようにしましょう。


<ホスト名01>,<ユーザ名01>,<パスワード01>
<ホスト名02>,<ユーザ名02>,<パスワード02>
<ホスト名03>,<ユーザ名03>,<パスワード03>

準備イメージ

実行イメージ

マクロから実行の場合：関数「RunAppMainAccount01」を実行すると「接続情報.txt」の１行目のログイン情報で処理される。

VBSファイルから実行する場合、VBSファイル内でマクロの関数「RunAppMainAccount01」が実行され、「接続情報.txt」の１行目のログイン情報で処理されます。

実行後、WinSCPが起動し、ログイン画面でログイン情報が入力されたら、次のボタンを押します。

掲載したコードでは、あえて「閉じる」ボタンを押して終了するようになっています。

「接続情報.txt」に正しい情報をセットするなど、「ログイン」ボタンを押しても良い状態になったら、マクロの「mdAPP」モジュールで「閉じる」を押すようにしている箇所があるので、「ログイン」ボタンを押すように変更します。※コメントの部分を切り替えるだけで良いです。

コードの説明

１．要素確認ソフト（Inspect.exe）のインストール

ハンドルを操作するには、「SendMessage」や「FindWindow」と「FindWindowEx」など、いろいろな手法がありますが、今回は「UIAutomation」の手法で行います。

対象のアプリのハンドルを確認するのに、Inspect.exeを使用します。Windows SDKをインストールすると利用可能になります。

Windows SDK - Windows アプリ開発 | Microsoft Developer
Windows SDK - Windows アプリ開発 | Microsoft Developer

Windows 11のWindows SDKには、Windows で実行されるアプリを作成するときに使用できるヘッダー、ライブラリ、ツールが含まれています。

続きを見る

２．要素の確認

ハンドルを確認したいWinSCPを起動し、Inspect.exeを用いてハンドル情報を確認していきます。

「UIAutomation」で「ハンドル名（Name）」と「クラス名（ClassName）」を参照にして子ウィンドウにアクセスするには、その上階層の親からアクセスする必要があります。

ハンドル番号でもアクセスできそうですが、ハンドル番号は自動的に割り当てられるので、今後変わる可能性があることを考慮して、今回は利用しないようにしました。

同じウィンドウ画面に「ホスト」、「ユーザ名」、「パスワード」の入力欄があるので、一見簡単にできると思っていたのですが、「ハンドル名（Name）」と「クラス名（ClassName）」が同じものが多かったため、実際は結構大変な作業でした。

操作したい箇所を選択し、「名前」と「クラス名」をメモします。

WinSCPのルート階層と下の階層を確認する。その結果を添付します。

次に、ログイン画面の下の階層を確認する。その結果を添付します。

更にその下の階層を確認する。同じく結果を添付します。

プログラムでは、ホスト、ユーザ名、パスワードを入力するには、【①WinSCP→②ログイン画面→③その下層のウィンドウ→④その下層のウィンドウ→⑤セッションウィンドウ→⑥ホスト、ユーザ名、パスワード】のように、親ハンドルから子ハンドルに移動する必要があります。

「閉じる」ボタン、「ログイン」ボタンは、別の階層にあるので、再度辿るように設定しました。

また、Flash関数は、ヒットした部品が点滅できるように設定することができる関数です。

備考

  • 「接続情報.txt」はドライブや別の場所にあげるとセキュリティ面で良いと思う。
  • Excelマクロのファイルのシート上に、「ログイン情報毎にボタンを用意して、クリックするとその情報でログインできる」というようにすると尚良し。

参考サイト／関連サイト

【VBAでUIAutomation】アプリケーションをマクロで動かす | やろまいCode

【VBA】UIAutomationで業務改善２ | 崖っぷち派遣社員の日常

【VBA】UIAutomationで業務改善３ | 崖っぷち派遣社員の日常

最後までお付き合いいただきありがとうございます！

この情報が誰かの役にたてれば幸いです。

スポンサーリンク

-その他