VBScript
VBA
RPA

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


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>