More than 5 years have passed since last update.

RPAで業務を効率化って、専用ソフトとか無くてもソコソコできますよ（その3）

Last updated at 2019-01-31Posted at 2019-01-05

IE操作関連（機能追加）

XPath利用可能に

IEの自動操作。
きちんとIDが振ってあるときはgetElementByIdでいいんだけど、無いとgetElemnetsByNameやgetElementsByTagNameで複数取得してグルグル回してとか面倒でしかたない。
「XPathは使えないのか」とググってみたら、あるじゃないですか。
以下のサイトを参考に（というかほぼそのまま）クラスに追加しました。

JavaScript-XPath をリリースしました！さあ、あなたも XPath を使おう！

ただし、公式サイトが落ちてるようなので、InternetArchive等からファイルを取得する必要があります。

通知バーの保存ボタンのクリック

IEが関連する一連の自動操作では「Webシステムからファイル（CSV等）をダウンロードして、別システムへ連携」といったものもあります。
FireFoxやChromeなら自動的に保存してくれますが、IEは通知バーが出るので保存ボタンをクリックする必要が。
最初は「マウスカーソルを座標指定で」とかやってましたが、どうにもイケてない。
こちらもググってみたら、エクセルを使いますが何とかなりそうなので実装しました。

VBAを記述したエクセルをいっしょに保存する必要があるので、後にあるVBAを書いただけのエクセルを作成して呼び出すようにしてます。

IeUtilClass.vbs

Class IeUtilClass
    ' 変数宣言 -----------------------------------
    Private ieObj
    Private xp

    ' プロパティ宣言 -----------------------------
    Public Property Get IE()
        Set IE = ieObj
    End Property    

    ' コンストラクタ / デストラクタ --------------
    Private Sub Class_Initialize()
        Set ieObj = CreateObject("InternetExplorer.Application")
        ieObj.Visible = True
        Set xp = New XPath
    End Sub
    Private Sub Class_Terminate()
        Set ieObj = Nothing
        Set xp = Nothing
    End Sub

    ' IE操作関数 ---------------------------------
    Public Sub SetFullScreen(bool)
        ieObj.FullScreen = bool
    End Sub
    ' ページを開く
    Public Sub Navigate(url)
        ieObj.Navigate url
        WaitProc
    End Sub
    ' ページを開く（表示待ち無し）
    Public Sub NavigateNoWait(url)
        ieObj.Navigate url
    End Sub
    ' ページ表示待ち
    Public Sub WaitProc()
        'WScript.Echo "WaitProc"
        Do While ieObj.Busy = True Or ieObj.readyState <> 4
        Loop
    End Sub
    
    ' 要素取得関数 -------------------------------
    Public Function getElementById(id)
        Set getElementById = ieObj.document.getElementById(id)
    End Function

    Public Function getElementsByName(name)
        Set getElementsByName = ieObj.document.getElementsByName(name)
    End Function

    Public Function getElementsByTagName(name)
        Set getElementsByTagName = ieObj.document.getElementsByTagName(name)
    End Function

    Public Function getElementsByClassName(name)
        Set getElementsByClassName = ieObj.document.getElementsByClassName(name)
    End Function

    Public Function getElementsByXpath(xpath)
        ' XPathで検索を実行
        Set getElementsByXpath = xp.search(xpath, ieObj.document)(0)
    End Function

    Public Sub ClickSaveButton()
        Set Obj = WScript.CreateObject("Excel.Application")
        Set Path = CreateObject("Scripting.FileSystemObject").GetFolder(".")

        Obj.Visible = False
        CreateObject("WScript.Shell").AppActivate Obj.Caption
        Obj.Workbooks.Open Path & "\IeSaveBtnClick.xlsm"
        Obj.Application.Run "ClickSaveButton"
        Obj.Workbooks.Close
        Obj.Quit
        Set Obj = Nothing
    End Sub

    ' イベント発火 -------------------------------
    Public Sub triggerEvents(elm, events)
        elm.FireEvent(events)
    End Sub

End Class

'###########################################################
'                       XPath検索クラス
' [クラス名] XPath
'
' [関数] ○search(path as String, node as element)
'      ・機能
'          指定nodeを基にpathで表される要素の一覧を検索し返却する。
'      ・引数
'          path：XPath形式で指定。
'          node：検索の基となるノード。
'      ・戻り値
'          ArrayList：検索結果の一覧を返却。
'                     要素が存在しない場合でも空のArrayListを返す。
'                     ArrayListのメンバはMSDN参照。
'                     (Count、Item、Add、Remove、Containsなどが使える。
'                      For Each item in ArrayList ～ Next形式も可。）
'
' [制限事項]
'      ・エラー処理は入れていません。
Class XPath
    ' xpath用のdocumentオブジェクト
    Private doc
    '----------------------------------------------------
    ' コンストラクタ
    Private Sub Class_Initialize
        Dim script
        Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject")
        ' documentオブジェクトを作成
        Set doc = WScript.CreateObject("htmlfile")
        doc.write "<head></head><body></body>"

        ' xpathライブラリを読み込む
        ' ファイル読み込みで"script.text=～"指定でもよい
        ' サンプルでは直アクセスで確認
        Set script = doc.createElement("script")
        script.src = fso.getParentFolderName(WScript.ScriptFullName) & "\javascript-xpath-latest.js"

        ' documentに設定
        doc.getElementsByTagName("head")(0).appendChild script
    
    End Sub

    '----------------------------------------------------
    ' xpath指定での検索を実行
    Public Function search(path, node)
        Dim ret, i
        ' 検索実行
        Set ret = doc.Evaluate(path, node, null, 7, null)
        ' 検索結果をArrayListに格納
        Set search = WScript.CreateObject("System.Collections.ArrayList")
        For i = 0 To ret.snapshotLength - 1
            search.add ret.snapshotItem(i)
        Next
    End Function

End Class

IE通知バーの「保存」ボタンクリック用エクセルマクロ

IeSaveBtnClick.xlsm(の中のVBAのソース)

Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long

Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hwnd As LongPtr) As Long

Sub ClickSaveButton()

Dim ie As Object
Dim objInpTxtArea As HTMLTextAreaElement
Dim Button As HTMLInputElement


'参照設定　Microsoft HTML Object Library

    Set ie = getIE

    Dim AutomationObj As IUIAutomation
    Dim WindowElement As IUIAutomationElement
    Dim button2 As IUIAutomationElement
    Dim hwnd As Long
    Dim ieWnd As Long
    
    Set AutomationObj = New CUIAutomation
    
    ieWnd = ie.hwnd
    Do
        DoEvents
        Sleep 1&
        hwnd = FindWindowEx(ieWnd, 0, "Frame Notification Bar", vbNullString)
    Loop Until hwnd

    Do
        DoEvents
        Sleep 1&
    Loop Until IsWindowVisible(hwnd)
    
    Set WindowElement = AutomationObj.ElementFromHandle(ByVal hwnd)
    Dim iCnd As IUIAutomationCondition
    Do
        DoEvents
        Sleep 1&
        Set iCnd = AutomationObj.CreatePropertyCondition(UIA_NamePropertyId, "保存")
    Loop While iCnd Is Nothing
    
    Sleep 1000
    Set button2 = WindowElement.FindFirst(TreeScope_Subtree, iCnd)
    Dim InvokePattern As IUIAutomationInvokePattern
    Set InvokePattern = button2.GetCurrentPattern(UIA_InvokePatternId)
    InvokePattern.Invoke

End Sub

Public Function getIE() As Object
    Dim objSh As Object
    Dim objW As Object
    Dim i As Integer

    'IEがすでに立ち上がっている場合はそれを活用する
    Set objSh = CreateObject("Shell.Application")
    For i = objSh.Windows.Count To 1 Step -1
        Set objW = objSh.Windows(i - 1)
        If objW.FullName Like "*iexplore.exe" Then
          Set getIE = objW
          Exit Function
        End If
    Next

End Function

呼び出しサンプル

sample.wsf

<JOB ID="IE_XPATH_SAMPLE">
	<COMMENT>
		********************************************
		※ COMMENT
		********************************************
	</COMMENT>

	<script language="VBScript" src="IeUtilClass.vbs"/>

	<OBJECT id="objWS" progid="WScript.Shell" />
	<OBJECT id="objFSO" progid="Scripting.FileSystemObject" />

	<SCRIPT language="VBScript">
		'*******************************************
		' 処理開始
		'*******************************************
		comFilePath = objFSO.getParentFolderName(WScript.ScriptFullName) & "\"

		Dim ie : Set ie = New IeUtilClass

		ie.Navigate ""

		' 
		Dim btn
		Set btn = ie.getElementsByXpath("//*[@id=""dlbutton""]")
		btn.Click

		'
		'WScript.Sleep(2000)
		WScript.Echo "Start"
		ie.ClickSaveButton
		WScript.Echo "End"

		WScript.Quit

	</SCRIPT>
</JOB>

You get articles that match your needs
You can efficiently read back useful information
You can use dark theme

What you can do with signing up