汎用RPAエンジンとして作りました。まだ、不安定な所もあります。
●●●チャレンジさんのサイトでテストをさせて貰いました。
早いかどうか良くわかりませんが、約9秒程度です。（若干、web表示と相違します）
参考コードとして紹介させてもらいます。
(初めて、QIITAを利用し編集の仕方も儘ならないまま掲載しています。当分はこのまま)
全体コード等は、
「VBAとPowerShellで作るWebView2/CDP駆動のRPAエンジン」
（1/2）、（2/2）です。
（1/2）、（2/2) ６月下旬に初めて投稿しましたが、ベタ書きでした。その後、バージョンアップしました。
GITHUBの整理が出来たら削除しときます。
GITHUBに移動しました。（予定）（READMEの編集が良く判りませんが、少しづつ修正しています。）
**コード検証・改修はお願いします。**バグ等を教えていただけたら幸いです。
Option Explicit
' --- 高精度タイマー用 API宣言 ---
Private Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
Dim freq As Currency
Dim startTime As Currency: Dim endTime As Currency: Dim elapsedTimeMs As Double
' --- その他API宣言 ---
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
' --- エンジンパス等の定数定義 ---
Private Const PS_ENGINE_LIB As String = "\Ps_Engine_Core_v101.ps1"
Dim rpaEngine As Ps_Engine
' ------------------------------------------------------------------------------
' RPAエンジンTEST1
' ------------------------------------------------------------------------------
Sub Run_MainProcess1()
Dim ENGINE_PATH As String
Dim sessionId As String
Dim result As String
QueryPerformanceFrequency freq ' CPUの周波数を取得
' --- 実行環境の初期化 ---
ENGINE_PATH = ThisWorkbook.Path & PS_ENGINE_LIB
sessionId = "SESSION_" & Format(Now, "yyyyMMdd_HHmmss")
Set rpaEngine = New Ps_Engine
Debug.Print "=== 処理開始: " & sessionId & " ==="
Dim useCdpPort As Integer ' 通信モード (0: 標準, 9222等: CDP)
useCdpPort = 0
useCdpPort = 9222
' --- エンジンの起動および接続確認 ---
If Not rpaEngine.StartEngine(sessionId, ENGINE_PATH, useCdpPort, True) Then
MsgBox "エンジンの起動に失敗しました。", vbCritical
Exit Sub
End If
On Error GoTo ErrorHandler
Dim ws As Worksheet
Dim r As Long
' データの入っているシートを指定
Set ws = ThisWorkbook.Sheets("Sheet1")
' --- 2. RPA Challenge サイトへ遷移 ---
rpaEngine.RunAction "Invoke-WebNavigation", CreateParams("Url", "https://●●●challenge.com/")
rpaEngine.RunAction "Wait-WebPageLoad"
' Excelを強制的に最前面へ
Call ForceFocusExcel
MsgBox "ページが表示されました。" & vbCrLf & _
"手動で言語の切り替え（またはログイン操作等）を行い、" & vbCrLf & _
"準備ができたら「 OK 」を押してください。", _
vbInformation, "/// 手動操作・確認待機 ///"
' 【対策1】裏に隠れてしまったブラウザ（RPA Browser）を一番手前に呼び戻す
On Error Resume Next
AppActivate "RPA Browser"
On Error GoTo ErrorHandler ' エラー処理の設定を元に戻す
' 【対策2】人間が操作した後の画面の切り替えが完全に落ち着くまで2秒待つ
Application.Wait Now + TimeValue("00:00:02")
' --- RPAチャレンジ開始！（ハイライトをOFFにする） ---
rpaEngine.RunAction "Set-EngineConfig", CreateParams("EnableHighlight", False)
' --- 3. [Start] ボタンをクリックして計測開始 ---
QueryPerformanceCounter startTime '（開始時間を取得）
rpaEngine.RunAction "Invoke-WebClick", CreateParams("Selector", "button.waves-effect.col.s12.m12.l12.btn-large.uiColorButton")
' --- 4. Excelのデータ行数分ループ (全10ラウンド) ---
' ※2行目から11行目までデータがある
For r = 2 To 11
Application.StatusBar = "Round " & (r - 1) & " を入力中..."
' ① First Name
rpaEngine.RunAction "Set-WebXPathTextInput", _
CreateParams("XPath", "//label[normalize-space(text())='First Name']/following-sibling::input", "Value", ws.Cells(r, 1).Value)
' ② Last Name
rpaEngine.RunAction "Set-WebXPathTextInput", _
CreateParams("XPath", "//label[normalize-space(text())='Last Name']/following-sibling::input", "Value", ws.Cells(r, 2).Value)
' ③ Company Name
rpaEngine.RunAction "Set-WebXPathTextInput", _
CreateParams("XPath", "//label[normalize-space(text())='Company Name']/following-sibling::input", "Value", ws.Cells(r, 3).Value)
' ④ Role in Company
rpaEngine.RunAction "Set-WebXPathTextInput", _
CreateParams("XPath", "//label[normalize-space(text())='Role in Company']/following-sibling::input", "Value", ws.Cells(r, 4).Value)
' ⑤ Address
rpaEngine.RunAction "Set-WebXPathTextInput", _
CreateParams("XPath", "//label[normalize-space(text())='Address']/following-sibling::input", "Value", ws.Cells(r, 5).Value)
' ⑥ Email
rpaEngine.RunAction "Set-WebXPathTextInput", _
CreateParams("XPath", "//label[normalize-space(text())='Email']/following-sibling::input", "Value", ws.Cells(r, 6).Value)
' ⑦ Phone Number
rpaEngine.RunAction "Set-WebXPathTextInput", _
CreateParams("XPath", "//label[normalize-space(text())='Phone Number']/following-sibling::input", "Value", ws.Cells(r, 7).Value)
' --- 5. [Submit] ボタンをクリックして次のラウンドへ ---
' Submitボタンはタグとtype等で特定可能
rpaEngine.RunAction "Invoke-WebClick", CreateParams("Selector", "input[type='submit']")
Next r
QueryPerformanceCounter endTime '（終了時間を取得）
elapsedTimeMs = (endTime - startTime) / freq * 1000
Debug.Print "★ RPA Challenge: " & Format(elapsedTimeMs, "0.00") & " ミリ秒" & " 若干相違があるが!?"
Application.StatusBar = False
MsgBox "RPA Challenge 完了！ブラウザのスコアを確認してください。", vbInformation
' ..----------------------------------------------------------------------------
Debug.Print "--- キャッシュクリア実行 ---"
rpaEngine.RunAction "Clear-WebCache", CreateParams("Mode", "CacheOnly")
DoEvents
rpaEngine.RunAction "Clear-WebCache", CreateParams("Mode", "All")
' --- メモリ解放 ---
CleanUp:
If Not rpaEngine Is Nothing Then
rpaEngine.CloseEngine
End If
Set rpaEngine = Nothing
Exit Sub
' --- 異常系のハンドリング（エラー捕捉） ---
ErrorHandler:
If Err.Source = "PS_Engine" Then
Dim rpaErr As RpaExceptionInfo ' 例外情報を格納する構造体（エラー文字列をパース）
rpaErr = ParseRpaError(Err.Description)
Select Case rpaErr.ErrorType
Case "未発見"
Debug.Print "【スキップ】要素が見つかりません: " & rpaErr.Details
'● Resume Next
Case "Timeout"
Debug.Print "【待機超過】画面の応答がありません (" & rpaErr.FunctionName & ")"
Case "JSエラー", "ネイティブエラー", "内部エラー"
MsgBox "ブラウザ制御内で致命的なエラーが発生しました。" & vbCrLf & _
"関数: " & rpaErr.FunctionName & vbCrLf & _
"内容: " & rpaErr.Message, vbCritical
Case Else
Debug.Print "【その他エラー】" & rpaErr.RawText
End Select
Else
MsgBox "VBAマクロエラー (" & Err.Number & "): " & Err.Description, vbCritical
End If
On Error Resume Next
rpaEngine.RunAction "Export-WebScreenshot", CreateParams("Prefix", "ErrorHandler")
MsgBox "*** エラーが発生しました:" & vbCrLf & Err.Description, vbCritical
Resume CleanUp
End Sub