Edge標準モード自動化の実装例

先日書いたVBAからEdge標準モード自動操作を使った、実装例を紹介します。

私が実務でこの「ブラウザ自動操作」を使って暫く経ちましたが、だいぶ動作が安定してきたので、ここらで具体的な実装例を紹介したいと思います。
どんな風にVBAコードを組立てれば上手く動くのか、動作が安定するのか、事故率を抑えられるのか等、何らかのヒントになれば幸いです。
※自分がブラウザ自動化に取り組み始めた頃、具体的な実装例（参考例）があればどんなに助かっただろうか、という苦い経験を思い出しました。ここでは具体的な要素名やID等は載せられないので抽象度合いは上がりますが、それでも実装例を紹介することで、同じ苦労を抱える方の助けになればと思います。

ちなみに、関連記事としてTips集（〇〇したいときはこう書く）も書いています。シチュエーション毎の対処法を知りたい時はこっちを見てください。

ということで、日々の業務にありがちな、以下の処理を行うVBAコードの実装例です。

【実装例その１】
１．業務ページ（勤怠入力システム）のスタートページを立ち上げる
　（ログイン画面に阻まれた場合は、ログイン処理へ進む）
２．ユーザー入力検知機能付きのログイン画面でログイン処理をする
　（Tabキーを疑似的に送信することで認証突破）
３．ログイン後に、「打刻」ボタンを押す

'WSA関連
Private Type WSAData 'ソケット初期化用構造体
  wVersion As Integer
  wHighVersion As Integer
  szDescription As String * 257 'WSA_DESCRIPTIONLEN + 1
  szSystemStatus As String * 129 'WSA_SYS_STATUS_LEN + 1
  iMaxSockets As Integer
  iMaxUdpDg As Integer
  lpVendorInfo As Long
End Type
Private Declare PtrSafe Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequired As Integer, ByRef lpWSAData As WSAData) As Long
Private Declare PtrSafe Function WSACleanup Lib "ws2_32.dll" () As Long
Private Declare PtrSafe Function WSAGetLastError Lib "ws2_32.dll" () As Long
'------------------------
'アドレス取得
Private Declare PtrSafe Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long
Private Declare PtrSafe Function htons Lib "ws2_32.dll" (ByVal hostshort As Long) As Integer
'------------------------
'ソケット接続
Private Type sockaddr_in 'ソケットアドレス
  sin_family As Integer
  sin_port As Integer
  sin_addr As Long
  sin_zero1 As Long
  sin_zero2 As Long
End Type
Private Declare PtrSafe Function socket Lib "ws2_32.dll" (ByVal af As Long, ByVal socktype As Long, ByVal protocol As Long) As Long
Private Declare PtrSafe Function closesocket Lib "ws2_32.dll" (ByVal S As Long) As Long
Private Declare PtrSafe Function connect Lib "ws2_32.dll" (ByVal S As Long, ByRef name As sockaddr_in, ByVal namelen As Long) As Long
Private Declare PtrSafe Function ioctlsocket Lib "ws2_32.dll" (ByVal S As Long, ByVal cmd As Long, argp As LongPtr) As Long
Private Const FIONBIO = &H8004667E
'------------------------
'ソケット送受信
Private Declare PtrSafe Function send Lib "ws2_32.dll" (ByVal S As Long, ByRef buf As Any, ByVal length As Long, ByVal flags As Long) As Long
Private Declare PtrSafe Function strsend Lib "ws2_32.dll" Alias "send" (ByVal S As Long, ByVal buf As String, ByVal length As Long, ByVal flags As Long) As Long
Private Declare PtrSafe Function recv Lib "ws2_32.dll" (ByVal S As Long, ByRef buf As Any, ByVal length As Long, ByVal flags As Long) As Long
Private Declare PtrSafe Function strrecv Lib "ws2_32.dll" Alias "recv" (ByVal S As Long, ByVal buf As String, ByVal length As Long, ByVal flags As Long) As Long
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'------------------------
'ウィンドウ関連
Private Declare PtrSafe Function GetParent Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal IpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hWnd As LongPtr, ByVal wFlag As LongPtr) As LongPtr
Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As LongPtr, ByRef lpdwProcessId As LongPtr) As LongPtr
Private Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As LongPtr) As LongPtr
Private Declare PtrSafe Function QueryFullProcessImageName Lib "kernel32" Alias "QueryFullProcessImageNameA" (ByVal hProcess As LongPtr, ByVal dwFlags As Long, ByVal lpExeName As String, ByRef lpdwSize As Long) As Long
Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As LongPtr) As Long
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As LongPtr) As LongPtr
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const GW_HWNDNEXT = &H2
'------------------------
'キーコード送信用API
Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As LongPtr, ByVal wparam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As LongPtr, ByVal wMapType As LongPtr) As LongPtr
'------------------------
'モジュールレベル変数
Private Frame() As Byte '通信データを格納するためのフレーム



'-----------メイン処理１-----------
'勤怠（打刻）システムのスタートページを開く
Private Sub Main()
  '認証ページ用のID・パスワードを設定
  Dim USER_ID As String
  Dim PassWord As String
  USER_ID = "***********"
  PassWord = "***********"
  
  'Edgeプロセスを終了（バックグラウンドも含めてプロセスキル）
  With CreateObject("WScript.Shell")
    .Run "taskkill /F /IM msedge.exe", 0, True
  End With

  'リモートデバックポートを使用してEdge起動
  Dim edgePath As String
  Dim rc As Long
  edgePath = Environ("ProgramFiles(x86)") & "\Microsoft\Edge\Application\msedge.exe"
  'edgePath = Environ("ProgramFiles") & "\Microsoft\Edge\Application\msedge.exe"
  'edgePath = Environ("LOCALAPPDATA") & "\Microsoft\msedge.exe"
  rc = Shell(edgePath & " --remote-debugging-port=9222", vbNormalFocus)
 
  'アタッチ可能なターゲット一覧を取得
  Dim URL As String
  Dim req As Object
  Dim resText As String
  URL = "http://localhost:9222/json/list" 'Devtools Protocolエンドポイント
  Set req = CreateObject("MSXML2.ServerXMLHTTP")
  'Set req = CreateObject("MSXML2.XMLHTTP")
  'Set req = CreateObject("WinHttp.WinHttpRequest")
  req.Open "GET", URL, False
  req.setRequestHeader "Content-Type", "application/json"
  req.send
  resText = req.responseText
  Set req = Nothing
 
  'ターゲット一覧から、操作対象のIDを取得（type=pageであるターゲットのid値）
  Dim reg As Object
  Dim IDs() As String
  Dim ID As String
  Dim TrimText As String
  Set reg = CreateObject("VBScript.RegExp")
  With reg
    .Pattern = """id"": ""[^""]+"""
    .IgnoreCase = True
    .Global = True
    ReDim IDs(.Execute(resText).Count - 1)
    For i = 0 To .Execute(resText).Count - 1
      IDs(i) = Mid(resText, .Execute(resText)(i).firstindex + 8, .Execute(resText)(i).length - 8)
      If i < .Execute(resText).Count Then
        TrimText = Mid(resText, .Execute(resText)(i).firstindex, .Execute(resText)(i).firstindex + 1)
        If InStr(TrimText, """type"": ""page""") > 0 Then
          ID = IDs(i)
        End If
      End If
    Next i
  End With
  Set reg = Nothing

  '目的ページを開く
  Dim CDP_Command As String
  Dim response As String
  CDP_Command = "{""id"":1, " & _
      """method"":""Page.navigate"", " & _
      """params"":{""url"":""https://www.*********/""}}"
  response = WebSocket_Submit(CDP_Command, ID)  'Sub①

  'ページ読み込み待機（=Page.loadEventFiredイベントが発生するまで待機）
  Dim EverntName As String
  CDP_Command = "{""id"":2, " & _
      """method"":""Page.enable""}"
  EventName = "Page.loadEventFired"
  response = WebSocket_Submit(CDP_Command, ID, EventName)
  If response = "" Then End
  'If InStr(response, EventName) > 0 Then
  '  Debug.Print EventName & "イベントを検知しました"
  'End If
  
  'ターゲットIDの情報を取得
  Dim TimeOutCnt As Integer
  response = ""
  Do
    CDP_Command = "{""id"":3, " & _
        """method"":""Target.getTargets""}"
    response = WebSocket_Submit(CDP_Command, ID)
    TimeOutCnt = TimeOutCnt + 1
    If TimeOutCnt > 10 Then Exit Do
    Sleep 500
  Loop Until response <> ""
  
  'ログイン認証状況を判別
  Dim jsCode As String
  If InStr(response, "目的ページが特定できるような一部（URLの一部など）ここに記載") > 0 Then
    'Debug.Print "ログイン済みです。ログイン処理はスキップします"
  ElseIf InStr(response, "ログインページが特定できるような一部（URLの一部など）をここに記載") > 0 Then
    'Debug.Print "未ログインです。続けて処理します"
    Sleep 1000 '念のため
    Call LogIn(ID, PassWord) 'ログインプロシージャを呼び出してログイン処理を行う
  ElseIf InStr(response, "リダイレクト画面が特定できるような一部（UELの一部など）をここに記載") > 0 Then
    'Debug.Print "ログイン画面へリダイレクト中です。待機処理します"
    TimeOutCnt = 0
    Do
      CDP_Command = "{""id"":4, " & _
          """method"":""Target.getTargets""}"
      response = WebSocket_Submit(CDP_Command, ID)
      TimeOutCnt = TimeOutCnt + 1
      If TimeOutCnt > 10 Then Exit Do
      Sleep 500
    Loop Until InStr(response, "リダイレクト画面が特定できるような一部をここに記載") = 0
    Sleep 1000 '念のため
    Call LogIn(ID, PassWord) 'ログインプロシージャを呼び出してログイン処理を行う
  Else
    'Debug.Print "想定外エラー。処理中断します" & response
    End
  End If

  'ページ読み込み待機（=Network.loadingFinishedイベントが発生するまで待機）
  CDP_Command = "{""id"":11, " & _
      """method"":""Network.enable""}"
  EventName = "Network.loadingFinished"
  response = WebSocket_Submit(CDP_Command, ID, EventName)
  If response = "" Then End
  Sleep 1000

  '「打刻システムを開く」ボタンを押下
  jsCode = "javascript:window.open('http://**********','blank');"
  CDP_Command = "{""id"":12, " & _
    """method"":""Runtime.evaluate"", " & _
    """params"":{""expression"":""" & jsCode & """}}"
  response = WebSocket_Submit(CDP_Command, ID)
  
  '新しいウィンドウ情報を取得できるまでループ'
  '従来ウィンドウ（ログイン後の画面）のターゲットID＝変数ID、新しいウィンドウ（打刻システム画面）のターゲットID=変数NewID
  TimeOutCnt = 0
  Do
    CDP_Command = "{""id"":13, " & _
        """method"":""Target.getTargets""}"
    response = WebSocket_Submit(CDP_Command, ID)
    Dim TabIDs() As String
    Dim NewID As String
    Set reg = CreateObject("VBScript.RegExp")
    With reg
      .Pattern = """targetId"": ""[^""]+"""
      .IgnoreCase = True
      .Global = True
      ReDim TabIDs(.Execute(response).Count - 1)
      For i = 0 To .Execute(response).Count - 1
        TabIDs(i) = Mid(response, .Execute(response)(i).firstindex + 13, .Execute(response)(i).length - 13)
        nEnd = InStr(.Execute(response)(i).firstindex, response, "}")
        TrimText = Mid(response, .Execute(response)(i).firstindex, nEnd - .Execute(response)(i).firstindex)
        If InStr(TrimText, """page""") > 0 And ID <> TabIDs(i) Then
          NewID = TabIDs(i)
          Exit Do
        End If
      Next i
    End With
    Set reg = Nothing
    TimeOutCnt = TimeOutCnt + 1
    If TimeOutCnt > 10 Then Exit Do
    Sleep 500
  Loop Until NewID <> ""

  '打刻システムで「打刻」ボタンをクリック
  jsCode = "document.getElementsById('****').click();"
  CDP_Command = "{""id"":14, " & _
    """method"":""Runtime.evaluate"", " & _
    """params"":{""expression"":""" & jsCode & """}}"
  response = WebSocket_Submit(CDP_Command, NewID)

  '従来ウィンドウ（ログイン後の画面）を閉じる
  CDP_Command = "{""id"":15, " & _
      """method"":""Page.close""}"
  response = WebSocket_Submit(CDP_Command, ID)
End Sub

'-----------メイン処理２-----------
’ログイン処理をする
Private Sub LogIn(ByVal pageID As String, PassWord As String)
  '「ID資格を保存する」チェックボックスにチェックを入れる
  Dim jsCode As String
  Dim CDP_Command As String
  Dim response As String
  jsCode = "document.getElementsById('****').click();"
  CDP_Command = "{""id"":5, " & _
    """method"":""Runtime.evaluate"", " & _
    """params"":{""expression"":""" & jsCode & """}}"
  response = WebSocket_Submit(CDP_Command, pageID)
 
  '「進む」ボタンをクリック
  jsCode = "var button = document.getElementsByTagName('input');" & _
    "for (var i = 0; i < button.length; i++) {" & _
    "　if (button[i].type === 'submit' && button[i].value === '進む') {" & _
    "　　button[i].click();" & _
    "　　break;" & _
    "　}" & _
    "}"
  CDP_Command = "{""id"":6, " & _
    """method"":""Runtime.evaluate"", " & _
    """params"":{""expression"":""" & jsCode & """}}"
  response = WebSocket_Submit(CDP_Command, pageID)

  'ページ読み込み待機（=Page.loadEventFiredイベントが発生するまで待機）
  Dim TimeOutCnt As Integer
  Dim EverntName As String
  TimeOutCnt = 0
  Do
    CDP_Command = "{""id"":7, " & _
        """method"":""Network.enable""}"
    EventName = "Network.loadingFinished"
    response = WebSocket_Submit(CDP_Command, pageID, EventName)
    'If InStr(response, EventName) > 0 Then
    '  Debug.Print EventName & "イベントを検知しました"
    'End If
    If TimeOutCnt > 30 Then Exit Do
    Sleep 500
  Loop Until InStr(response, "パスワード入力画面が特定できるような一部（URLなど）をここに記載") = 0

  'パスワード入力
  jsCode = "var textbox = document.getElementsByTagName('input');" & _
          "for (var i = 0; i < textbox.length; i++) {" & _
          "　if (textbox[i].type === 'password') {" & _
          "　　textbox[i].value=" & PassWord & ";" & _
          "　　break;" & _
          "　}" & _
          "}"
  CDP_Command = "{""id"":8, " & _
    """method"":""Runtime.evaluate"", " & _
     """params"":{""expression"":""" & jsCode & """}}"
  response = WebSocket_Submit(CDP_Command, pageID)

  'ユーザー入力を検知するスクリプトを突破する（TABキーを送り込むことで強行突破）
  'ブラウザUI部分（ツールバー等）へのフォーカスを回避しつつ、Webページ部分（コンテンツ内容）へのフォーカス状態を強制的に作る
  'JavaScriptのfocus()やclick()メソッドが使えるなら、そちらを使用。
  'alert()メソッドで一度ダイアログ表示することでブラウザUI部分へのフォーカスを回避。
  jsCode = "setTimeout(function(){;" & _
          "var img = document.getElementsByTagName('img');" & _
          "for (var i = 0; i < img.length; i++) {" & _
          "　alert(img[0]);" & _
          "　　break;" & _
          "　}" & _
          "}, 100);"
  CDP_Command = "{""id"":9, " & _
  """method"":""Runtime.evaluate"", " & _
     """params"":{""expression"":""" & jsCode & """}}"
  response = WebSocket_Submit(CDP_Command, pageID)
  
'-----------メイン処理３-----------
'ウィンドウハンドルを指定して、TabキーとEnterキーを送り込む
  Sleep 1000
  Dim hWnd As LongPtr
  Dim lParam As LongPtr
  Const VK_RETURN = &HD 'Enterキー
  Const VK_TAB = &H9 'Tabキー
  Const WM_KEYDOWN = &H100 'キーDownコード
  Do
    hWnd = getEdgeWindowHandle 'サブルーチンを呼び出す
  Loop Until hWnd <> 0
  'ダイアログのOKボタンを押す
  lParam = 1 + MapVirtualKey(VK_TAB, 0) * (2 ^ 16)
  PostMessage hWnd, WM_KEYDOWN, VK_TAB, lParam
  Sleep 1000
  lParam = 1 + MapVirtualKey(VK_RETURN, 0) * (2 ^ 16)
  PostMessage hWnd, WM_KEYDOWN, VK_RETURN, lParam
  Sleep 1500
  'パスワード入力用テキストボックスに直接TABキーを送り込む（ユーザー入力検知対策として）
  lParam = 1 + MapVirtualKey(VK_TAB, 0) * (2 ^ 16)
  PostMessage hWnd, WM_KEYDOWN, VK_TAB, lParam
  lParam = 1 + MapVirtualKey(VK_TAB, 0) * (2 ^ 16)
  PostMessage hWnd, WM_KEYDOWN, VK_TAB, lParam
  
  'ログインボタンをクリック
  jsCode = "var button = document.getElementsByTagName('input');" & _
    "for (var i = 0; i < button.length; i++) {" & _
    "　if (button[i].type === 'submit' && button[i].value === 'ログイン') {" & _
    "　　button[i].click();" & _
    "　　break;" & _
    "　}" & _
    "}"
  CDP_Command = "{""id"":10, " & _
    """method"":""Runtime.evaluate"", " & _
    """params"":{""expression"":""" & jsCode & """}}"
  response = WebSocket_Submit(CDP_Command, pageID)

End Sub

'-----------メイン処理4-----------
'起動中のEdge上位ウィンドウハンドルを取得して返す
Private Function getEdgeWindowHandle() As LongPtr
  '全プロセスの中からプロセス名「msedge.exe」のものを配列WindowInfo()へ格納
  Dim hWnd As LongPtr
  Dim pId As LongPtr
  Dim hProcess As LongPtr
  Dim lpExeName As String * 260
  Dim lpdwSize As Long
  Dim ret As Long
  Dim ProcessName As String
  Dim WindowInfo() As Variant
  Dim Num As Long
  Dim strClassName As String * 255
  hWnd = FindWindow(vbNullString, vbNullString)
  ReDim WindowInfo(3, 0)
  Do
    If IsWindowVisible(hWnd) <> 0 Then
      GetWindowThreadProcessId hWnd, pId 'pId=プロセスID
      hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, pId)
      If hProcess <> 0 Then
        lpdwSize = Len(lpExeName)
        ret = QueryFullProcessImageName(hProcess, 0, lpExeName, lpdwSize)
        If ret <> 0 Then
          ProcessName = Mid$(lpExeName, InStrRev(lpExeName, "\") + 1) 'プロセス名
          If InStr(ProcessName, "msedge.exe") > 0 Then
            ReDim Preserve WindowInfo(3, Num + 1)
            WindowInfo(1, Num) = ProcessName
            GetClassName hWnd, strClassName, Len(strClassName)
            WindowInfo(2, Num) = Left(strClassName, InStr(strClassName, vbNullChar) - 1) 'クラス名
            WindowInfo(3, Num) = hWnd
            Num = Num + 1
          End If
        End If
      End If
      CloseHandle hProcess 'プロセスハンドルを閉じる
    End If
    hWnd = GetNextWindow(hWnd, GW_HWNDNEXT)
  Loop Until hWnd = GetNextWindow(hWnd, GW_HWNDNEXT)
  
  'クラス名「MSCTFIME UI」かつ、２つ先祖（親）のクラス名が「Chrome_WidgetWin_1」であるウィンドウハンドルを特定する
  Dim P_hWnd As LongPtr
  Dim GP_hWnd As LongPtr
  Dim ClassName As String
  For i = 0 To UBound(WindowInfo, 2) - 1
    If WindowInfo(2, i) = "MSCTFIME UI" Then
      P_hWnd = GetParent(WindowInfo(3, i))
      GP_hWnd = GetParent(P_hWnd)
      GetClassName GP_hWnd, strClassName, Len(strClassName)
      ClassName = Left(strClassName, InStr(strClassName, vbNullChar) - 1)
      If ClassName = "Chrome_WidgetWin_1" Then
        getEdgeWindowHandle = GP_hWnd
        Exit Function
      End If
    End If
  Next
End Function
'-----------メイン処理（おわり）----------


'-----------サブルーチン処理----------
Private Function WebSocket_Submit(ByVal CDP_Command As String, ByVal ID As String, Optional ByVal EventName As String) As String　'Sub①
 '別記事で紹介。
 '「【VBA】Edge標準モードを自動操作（インストール不要）」の記事参照。
End Function
'-----------サブルーチン処理（おわり）----------

こんな感じです。



【実装例その２】
１．業務ページを立ち上げる
　（ログイン画面に阻まれた場合は、ログイン認証を突破する）
２．業務ページの情報をスクレイピング
　（動的生成されたコンテンツ情報も漏らさず情報取得する）

'WSA関連
Private Type WSAData 'ソケット初期化用構造体
  wVersion As Integer
  wHighVersion As Integer
  szDescription As String * 257 'WSA_DESCRIPTIONLEN + 1
  szSystemStatus As String * 129 'WSA_SYS_STATUS_LEN + 1
  iMaxSockets As Integer
  iMaxUdpDg As Integer
  lpVendorInfo As Long
End Type
Private Declare PtrSafe Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequired As Integer, ByRef lpWSAData As WSAData) As Long
Private Declare PtrSafe Function WSACleanup Lib "ws2_32.dll" () As Long
Private Declare PtrSafe Function WSAGetLastError Lib "ws2_32.dll" () As Long
'------------------------
'アドレス取得
Private Declare PtrSafe Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long
Private Declare PtrSafe Function htons Lib "ws2_32.dll" (ByVal hostshort As Long) As Integer
'------------------------
'ソケット接続
Private Type sockaddr_in 'ソケットアドレス
  sin_family As Integer
  sin_port As Integer
  sin_addr As Long
  sin_zero1 As Long
  sin_zero2 As Long
End Type
Private Declare PtrSafe Function socket Lib "ws2_32.dll" (ByVal af As Long, ByVal socktype As Long, ByVal protocol As Long) As Long
Private Declare PtrSafe Function closesocket Lib "ws2_32.dll" (ByVal S As Long) As Long
Private Declare PtrSafe Function connect Lib "ws2_32.dll" (ByVal S As Long, ByRef name As sockaddr_in, ByVal namelen As Long) As Long
Private Declare PtrSafe Function ioctlsocket Lib "ws2_32.dll" (ByVal S As Long, ByVal cmd As Long, argp As LongPtr) As Long
Private Const FIONBIO = &H8004667E
'------------------------
'ソケット送受信
Private Declare PtrSafe Function send Lib "ws2_32.dll" (ByVal S As Long, ByRef buf As Any, ByVal length As Long, ByVal flags As Long) As Long
Private Declare PtrSafe Function strsend Lib "ws2_32.dll" Alias "send" (ByVal S As Long, ByVal buf As String, ByVal length As Long, ByVal flags As Long) As Long
Private Declare PtrSafe Function recv Lib "ws2_32.dll" (ByVal S As Long, ByRef buf As Any, ByVal length As Long, ByVal flags As Long) As Long
Private Declare PtrSafe Function strrecv Lib "ws2_32.dll" Alias "recv" (ByVal S As Long, ByVal buf As String, ByVal length As Long, ByVal flags As Long) As Long
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'モジュールレベル変数
Private Frame() As Byte '通信データを格納するためのフレーム
Private Data() As Variant 'スクレイピング結果を格納する二次元配列



'-----------メイン処理１-----------
Private Sub Main()
  '認証ページ用のID・パスワードを設定
  Dim USER_ID As String
  Dim PASSWORD As String
  USER_ID = "***********"
  PASSWORD = "***********"
  
  '業務ページを立ち上げる
  Dim NewPageID As String
  NewPageID = LaunchTargetPage(USER_ID, PASSWORD)

  '業務ページをスクレイピングして処理結果をモジュールレベル変数Data()で受取る
  Call LetsScraping(NewPageID)

  'シートへ書き出す
  Dim sh As Worksheet
  Set sh = ActiveSheet
  sh.Range("A1").Resize(, UBound(Data, 2) + 1).Value = Data
End Sub

'-----------メイン処理２-----------
'業務ページを立ち上げて、そのページのターゲットIDを返す
Private Function LaunchTargetPage(ByVal USER_ID As String, ByVal PASSWORD As String) As String
  'Edgeプロセスを強制終了
  With CreateObject("WScript.Shell")
    .Run "taskkill /F /IM msedge.exe", 0, True
  End With

  'リモートデバックポートを使用してEdge起動
  Dim edgePath As String
  Dim rc As Long
  edgePath = Environ("ProgramFiles(x86)") & "\Microsoft\Edge\Application\msedge.exe"
  'edgePath = Environ("ProgramFiles") & "\Microsoft\Edge\Application\msedge.exe"
  'edgePath = Environ("LOCALAPPDATA") & "\Microsoft\msedge.exe"
  rc = Shell(edgePath & " --remote-debugging-port=9222", vbNormalFocus)
 
  'アタッチ可能なターゲット一覧を取得
  Dim URL As String
  Dim req As Object
  Dim resText As String
  URL = "http://localhost:9222/json/list" 'Devtools Protocolエンドポイント
  Set req = CreateObject("MSXML2.ServerXMLHTTP")
  'Set req = CreateObject("MSXML2.XMLHTTP")
  'Set req = CreateObject("WinHttp.WinHttpRequest")
  req.Open "GET", URL, False
  req.setRequestHeader "Content-Type", "application/json"
  req.send
  resText = req.responseText
  Set req = Nothing
 
  'ターゲット一覧から、操作対象のIDを取得（type=pageであるターゲットのid値）
  Dim reg As Object
  Dim IDs() As String
  Dim ID As String
  Dim nEnd As Long
  Dim TrimText As String
  Set reg = CreateObject("VBScript.RegExp")
  With reg
    .Pattern = """id"": ""[^""]+"""
    .IgnoreCase = True '大文字小文字を区別しない
    .Global = True '全体を検索
    ReDim IDs(.Execute(resText).Count - 1)
    For i = 0 To .Execute(resText).Count - 1
      IDs(i) = Mid(resText, .Execute(resText)(i).firstindex + 8, .Execute(resText)(i).length - 8)
      nEnd = InStr(.Execute(resText)(i).firstindex, resText, "}")
      TrimText = Mid(resText, .Execute(resText)(i).firstindex, nEnd - .Execute(resText)(i).firstindex)
      If InStr(TrimText, """type"": ""page""") > 0 Then
        ID = IDs(i)
      End If
    Next i
  End With
  Set reg = Nothing

  '業務ページ①を開く
  Dim CDP_Command As String
  Dim response As String
  CDP_Command = "{""id"":1, " & _
      """method"":""Page.navigate"", " & _
      """params"":{""url"":""https://www.*********/""}}"
  response = WebSocket_Submit(CDP_Command, ID)  'Sub①
  
  'ターゲットIDの情報を取得
  Dim TimeOutCnt As Integer
  response = ""
  Do
    CDP_Command = "{""id"":2, " & _
        """method"":""Target.getTargets""}"
    response = WebSocket_Submit(CDP_Command, ID)
    TimeOutCnt = TimeOutCnt + 1
    If TimeOutCnt > 10 Then Exit Do
    Sleep 500
  Loop Until response <> ""
  
  'ログイン認証状況を判別
  Dim jsCode As String
  If InStr(response, "業務ページ①が特定できるような一部（URLの一部など）ここに記載") > 0 Then
    'Debug.Print "認証済みです。認証処理はスキップします"
  ElseIf InStr(response, "認証ページが特定できるような一部（URLの一部など）をここに記載") > 0 Then
    'Debug.Print "未認証です。続けて処理します"
    jsCode = "var textbox = document.getElementsByTagName('input');" & _
            "for (var i = 0; i < textbox.length; i++) {" & _
            "　if (textbox[i].type === 'text') {" & _
            "　　textbox[i].value=" & USER_ID & ";" & _
            "　　textbox[i+1].value=" & PASSWORD & ";" & _
            "　　textbox[i+2].click();" & _
            "　　break;" & _
            "　}" & _
            "}"
    CDP_Command = "{""id"":3, " & _
        """method"":""Runtime.evaluate"", " & _
        """params"":{""expression"":""" & jsCode & """}}"
    response = WebSocket_Submit(CDP_Command, ID)
  Else
    'Debug.Print "想定外エラー。処理中断します" & response
    End
  End If

  '業務ページ②を開く
  '（業務ページ①を開いたうえで特定のJavaScriptを実行することで、初めて業務ページ②へアクセス可能になる様なシチュエーションを想定）
  jsCode = "javascript:window.open('http://**********','blank');"
  CDP_Command = "{""id"":4, " & _
    """method"":""Runtime.evaluate"", " & _
    """params"":{""expression"":""" & jsCode & """}}"
  response = WebSocket_Submit(CDP_Command, ID)
  
  '新しいウィンドウ/タブ情報が取得できるまでループ
  TimeOutCnt = 0
  Do
    '新しいウィンドウ/タブを含めたターゲットIDの一覧を取得
    CDP_Command = "{""id"":5, " & _
        """method"":""Target.getTargets""}"
    response = WebSocket_Submit(CDP_Command, ID)

    '従来ウィンドウ/タブ（業務ページ①）のターゲットID（変数ID）、新しいウィンドウ/タブ（業務ページ②）のターゲットID（変数NewID）
    Dim TabIDs() As String
    Dim NewID As String
    Set reg = CreateObject("VBScript.RegExp")
    With reg
      .Pattern = """targetId"": ""[^""]+"""
      .IgnoreCase = True
      .Global = True
      ReDim TabIDs(.Execute(response).Count - 1)
      For i = 0 To .Execute(response).Count - 1
        TabIDs(i) = Mid(response, .Execute(response)(i).firstindex + 13, .Execute(response)(i).length - 13)
        nEnd = InStr(.Execute(response)(i).firstindex, response, "}")
        TrimText = Mid(response, .Execute(response)(i).firstindex, nEnd - .Execute(response)(i).firstindex)
        If InStr(TrimText, """page""") > 0 And ID <> TabIDs(i) Then
          NewID = TabIDs(i)
          Exit Do
        End If
      Next i
    End With
    Set reg = Nothing
    TimeOutCnt = TimeOutCnt + 1
    If TimeOutCnt > 10 Then Exit Do
    Sleep 500
  Loop Until NewID <> ""
  
  'ページ読み込み待機（=Page.loadEventFiredイベントが発生するまで待機）
  CDP_Command = "{""id"":6, " & _
      """method"":""Page.enable""}"
  EventName = "Page.loadEventFired"
  response = WebSocket_Submit(CDP_Command, NewID, EventName)
  'If InStr(response, EventName) > 0 Then
  '  Debug.Print EventName & "イベントを検知しました"
  'End If
  Sleep 1000 '念のため

  '従来ウィンドウ/タブ（業務ページ①）を閉じる
  CDP_Command = "{""id"":7, " & _
      """method"":""Page.close""}"
  response = WebSocket_Submit(CDP_Command, ID)

  '取得した新しいターゲットIDを返す
  LaunchTargetPage = NewID
End Function


'-----------メイン処理３-----------
'業務ページをスクレイピングして、処理結果をモジュールレベル変数Data()へ格納する
Private Sub LetsScraping(ByVal NewPageID As String)
  'HTML全体（を含むレスポンス）を取得する
  'きちんと情報取得できるまでループ処理（動的に生成されたコンテンツをしっかりスクレイピングするため）
  Dim TimeOutCnt As Integer
  Dim jsCode As String
  Dim CDP_Command As String
  Dim response As String
  TimeOutCnt = 0
  Do
    jsCode = "document.documentElement.outerHTML;"
    CDP_Command = "{""id"":8, " & _
      """method"":""Runtime.evaluate"", " & _
      """params"":{""expression"":""" & jsCode & """}}"
    response = WebSocket_Submit(CDP_Command, NewPageID)

    'HTML部分のみを抽出
    Dim reg As Object
    Dim str As String
    Set reg = CreateObject("VBScript.RegExp")
    With reg
      .Global = False
      .Pattern = """value"":""[^""]+"""
      str = Mid(response, .Execute(response)(0).firstindex + 10, Len(response) - .Execute(response)(0).firstindex - 11 - 3)
    End With
    Set reg = Nothing
    str = Replace(str, "\""", """")
    
    'モジュールレベルの二次元配列Data()を初期化
    ReDim Data(1, 5)
    
    '文字列をHTMLドキュメントへパースして、DOM操作により欲しい情報を特定
    Dim tempObj As Object
    Dim Elem As Object
    Dim CElem As Object
    Dim GCElem As Object
    Set tempObj = CreateObject("htmlfile")
    tempObj.body.innerHTML = str
    For Each Elem In tempObj.getElementsByTagName("*****") 'タグ名を入力
      If InStr(DecodeStr(Elem.innerText), "●●●") > 0 Then
        Data(0, 0) = DecodeStr(Elem.getElementsByTagName("▲▲▲")(0).innerText) '欲しい情報①
      End If
      If InStr(DecodeStr(Elem.innerText), "□□□") > 0 Then
        Data(0, 1) = DecodeStr(Elem.getElementsByTagName("▲▲▲")(1).innerText) '欲しい情報②
      End If
      If InStr(DecodeStr(Elem.innerText), "×××") > 0 Then
        Data(0, 2) = DecodeStr(Elem.getElementsByTagName("▲▲▲")(1).innerText) '欲しい情報③
      End If
    Next
    For Each Elem In tempObj.getElementsByTagName("----------")
      If InStr(DecodeStr(Elem.innerText), "〇〇〇") > 0 Then
        For Each CElem In Elem.getElementsByTagName("▼▼")
          If InStr(DecodeStr(CElem.innerText), "◎◎◎その1") > 0 Then
            For Each GCElem In CElem.getElementsByTagName("◆◆")
              If GCEleme.innerText <> "" Then
                Data(0, 3) = DecodeStr(GCElem.innerText)
              End If
            Next
          ElseIf InStr(DecodeStr(CElem.innerText), "◎◎◎その2") > 0 Then
            For Each GCElem In CElem.getElementsByTagName("◆◆")
              If GCEleme.innerText <> "" Then
                Data(0, 4) = DecodeStr(GCElem.innerText)
              End If
            Next
          End If
        Next
      End If
    Next
    
    Set tempObj = Nothing
    teimoutcnt = TimeOutCnt + 1
    If TimeOutCnt > 10 Then Exit Do
    Sleep 1000
  Loop Until Data(0, 0) <> "" And Data(0, 3) <> ""

End Sub


'-----------メイン処理４-----------
'Unicodeエスケープ（\uXXXX形式をデコード）
Private Function DecodeStr(ByVal str As String) As String
  Dim reg As Object
  Dim str As String
  Set reg = CreateObject("VBScript.RegExp")
  With reg
    .Global = True
    .MultiLine = True
    .IgnoreCase = True
    .Pattern = "\\u([0-9A-Fa-f]{4})"
  End With
  Dim matches As Object
  Dim match As Object
  Dim unicodeChar As String
  Dim unicodeValue As Long
  Set matches = reg.Execute(str)
  For Each match In matches
    unicodeChar = match.SubMatches(0)
    unicodeValue = CLng("&H" & unicodeChar)
    str = Replace(str, matche.Value, ChrW("&H" & unicodeChar))
  Next
  Set reg = Nothing
  DecodeStr = str
End Function
'-----------メイン処理（おわり）----------


'-----------サブルーチン処理----------
Private Function WebSocket_Submit(ByVal CDP_Command As String, ByVal ID As String, Optional ByVal EventName As String) As String　'Sub①
 '別記事で紹介。
 '「【VBA】Edge標準モードを自動操作（インストール不要）」の記事参照。
End Function
'-----------サブルーチン処理（おわり）----------

こんな感じです。
実際の業務で使っているVBAコードを手直しして載せたので、タイプミスがあったらごめんなさい。

ポイントは、ウィンドウ/タブが複数に分かれるタイミングや、動的コンテンツが生成されるタイミング（＝生成されるまで待つ処理）など、要所要所でDo - Loop構文でループ処理することで、安定感を高めています。
またCDPのTarget.getTargetsコマンドの実行結果を文字列解析することで、開かれたWebページが「目的のページ」なのか「ログイン認証ページ」なのかを動的に判別しています。

実装例その１では、TABキーを目的の場所（パスワード入力用のテキストボックス）へ送り込むためにちょっとした工夫が必要な場合があります。（詳細はコメントアウト部参照）

実装例その２では、スクレイピングする処理（LetsScrapingプロシージャ部分）では、実際のWebページに対応するように適宜コードを書き換えてください。
JavaScriptの「document.documentElement.outerHTML」を使う事で、スクリプトで書き換わった後のHTMLコンテンツをごっそり情報取得しています。これなら動的に書き換わるWebページであっても、書き換わった後の内容を取得できるので問題ないはずです。