新・VBAでChromeDriverの自動更新する

2022.05.02

以前のプログラムはコチラ

VBAでChromeDriverを自動更新する
2022/04/02 ドライバー取得部分のソースを変更しましたこのページにあるソースはWindows OSを前提にしています毎回チェックするのは面倒だしエラー発生するのも嫌なので自動更新プログラムですChromeとChromeDriverの...
javeo.jp
2022.07.18

ちゃんと動くし悪くはないんですけどね、ソースが長いのとローカルにiniファイルを作る部分が都合悪い場合があるみたいなので発想を変えてシンプルな感じに作り直してみました

ソース

説明不要でソースだけあればいいって方のためにまずソース

Sub Sample()
Dim driver As Selenium.ChromeDriver
Call ChromeDriverCheck

Set driver = New Selenium.ChromeDriver
driver.start
driver.get "https://javeo.jp/"
'------------------------------
'メイン処理
'------------------------------
driver.Close
driver.Quit
set driver = Nothing
End Sub
Option Explicit
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
                        (ByVal pCaller As Long, _
                         ByVal szURL As String, _
                         ByVal szFileName As String, _
                         ByVal dwReserved As Long, _
                         ByVal lpfnCB As Long) As Long

Private driver As New Selenium.ChromeDriver
Private errMsgArr As Variant
Private i As Long
Private VerDiffErr As Boolean

Private strUrl As String
Private ChromeVersion As String
Private ChromeDriverVersion As String
Private ChromeDriverPath As String
 
Private objFso As Object ' Scripting.FileSystemObject '--- 「Microsoft Scripting Runtime」の参照設定
Private objReg As Object ' VBScript_RegExp_55.RegExp '--- 「Microsoft VBScript Regular Expressions 5.5」の参照設定
Private objMat As Object 'MatchCollection '--- 「Microsoft VBScript Regular Expressions 5.5」の参照設定
Private xmlhttp As Object ' MSXML2.XMLHTTP60 '--- 「Microsoft XML v6.0」の参照設定
Private htmlDoc As Object 'HTMLDocument '--- 「Microsoft HTML Object Library」の参照設定
 
Private Const CheckFolder As String = "drivercheck"
Private Const zipFile As String = "driver.zip"
Public Function ChromeDriverCheck() As Boolean
'====================================================================================================
'ChromeDriverを自動更新する
'一度強制的にSeleniumをスタートさせてエラーになったらエラーメッセージを分解してバージョン情報を収集する
'====================================================================================================
'---SeleniumBasicのフォルダを探す
With CreateObject("Scripting.FileSystemObject")
    Select Case True
        Case .FolderExists(Environ("ProgramFiles(x86)") & "\SeleniumBasic")
            ChromeDriverPath = Environ("ProgramFiles(x86)") & "\SeleniumBasic"
        Case .FolderExists(Environ("ProgramFiles") & "\SeleniumBasic")
            ChromeDriverPath = Environ("ProgramFiles") & "\SeleniumBasic"
        Case .FolderExists(Environ("ProgramW6432") & "\SeleniumBasic")
            ChromeDriverPath = Environ("ProgramW6432") & "\SeleniumBasic"
        Case .FolderExists(Environ("LOCALAPPDATA") & "\SeleniumBasic")
            ChromeDriverPath = Environ("LOCALAPPDATA") & "\SeleniumBasic"
        Case Else
            MsgBox "'SeleniumBasic'のフォルダが見つかりません", vbCritical
            ChromeDriverCheck = False
            Exit Function
    End Select
End With

On Error Resume Next
'---ヘッドレス状態で実行して起動成功するか試してみる
With driver
    .AddArgument ("--headless")
    .Start
End With
'---エラーになったらドラーバーを入れ替える
Select Case Err.Number
    Case 0 '---エラーにならなければSeleniumを落として終わり
        With driver
            .Close
            .Quit
        End With
    Case 33 '---SessionNotCreatedErrorを検知した時
        VerDiffErr = False
        '---バージョン情報を抽出するために正規表現を使う
        Set objReg = CreateObject("VBScript.RegExp")
        objReg.Pattern = "\d+\.\d+\.\d+" '---数字だけのマッチだからパターンだけで十分
        '---エラーメッセージを分解してバージョン情報を取得する
        errMsgArr = Split(Err.Description, vbLf)
        For i = LBound(errMsgArr) To UBound(errMsgArr)
            Select Case True
                Case Trim(errMsgArr(i)) = "SessionNotCreatedError" '---バージョン違いエラーであることを確認
                    VerDiffErr = True
                Case Trim(errMsgArr(i)) Like "Current browser version is *" '---Chromeのバージョンとパスが表示されている場合
                    Set objMat = objReg.Execute(errMsgArr(i))
                    ChromeVersion = objMat.Item(0)
                Case Trim(errMsgArr(i)) Like "(Driver info:*" '---ChromeDriverのバージョンが表示されている場合
                    Set objMat = objReg.Execute(errMsgArr(i))
                    ChromeDriverVersion = objMat.Item(0)
            End Select
        Next
        Set objReg = Nothing
        '---ErrNumberは33なのにメッセージが違った場合
        If VerDiffErr = False Then
            MsgBox Err.Description, vbCritical
            ChromeDriverCheck = False
            Exit Function
        End If
        '---ChromeDriverを入れ替える前に一度落とす
        With driver
            .Close
            .Quit
        End With
        '---入れ替えが失敗することがあるから念のため分岐しておく
        If ChromeDriverUpdate(ChromeVersion) = False Then
            MsgBox "ChromeDriverの更新に失敗しました" & vbCrLf & "Excelを全て終了して再実行してください", vbCritical
            ChromeDriverCheck = False
            Exit Function
        End If
        '---念のためテスト運転
        On Error GoTo ErrTest
        With driver
            .AddArgument ("--headless")
            .Start
            .Get ("https://javeo.jp")
            .Close
            .Quit
        End With
        On Error GoTo 0
        
    Case Else '---その他エラーはメッセージをそのまま出す
        MsgBox Err.Description, vbCritical
        ChromeDriverCheck = False
        Exit Function
End Select
On Error GoTo 0

ChromeDriverCheck = True
Exit Function
ErrTest:
    MsgBox "ChromeDriverの起動に失敗しました", vbCritical
    ChromeDriverCheck = False
End Function
Private Function ChromeDriverUpdate(ByVal TargetChromeDriverVersion As String) As String
'====================================================================================================
'https://chromedriver.chromium.org/ に用意されているAPIを使ってChrome.exeのバージョンに合わせたChromeDriverをダウンロードして保存する
'====================================================================================================
ChromeDriverUpdate = False
Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
Set htmlDoc = CreateObject("HTMLFile")
'Set htmlDoc = New HTMLDocument
Dim strReleaseVersion As String
With xmlhttp
    .Open "GET", "https://chromedriver.storage.googleapis.com/LATEST_RELEASE_" & TargetChromeDriverVersion '---Chromeドライバーが公開されているサイトからソースを取得
    .send
    Do While .readyState < 4
        DoEvents
    Loop
    strReleaseVersion = .responseText
    strUrl = "https://chromedriver.storage.googleapis.com/" & strReleaseVersion & "/chromedriver_win32.zip"
    URLDownloadToFile 0, strUrl, ChromeDriverPath & "\" & CheckFolder & "\" & zipFile, 0, 0 '---ファイルをダウンロードするWinAPI
    
    On Error Resume Next
    CreateObject("Scripting.FileSystemObject").DeleteFile ChromeDriverPath & "\" & "chromedriver.exe", True '---今のドライバーを削除する
    If Err.Number <> 0 Then
        ChromeDriverUpdate = False
        Exit Function
    End If
    On Error GoTo 0
    With CreateObject("Shell.Application") '---zipを既定のフォルダに向けて解凍する
        .Namespace((ChromeDriverPath)).CopyHere .Namespace((ChromeDriverPath & "\" & CheckFolder & "\" & zipFile)).Items
    End With
End With

ChromeDriverUpdate = True
Set htmlDoc = Nothing
Set xmlhttp = Nothing
End Function

ソースの説明

プログラムの方針

理想はChrome.exeのバージョンとChromeDriverのバージョンを取得して比較するだけの簡単なお仕事なんですが、ChromeDriverの取得方法が無い（多分）ので手っ取り早く一度Seleniumを実行してエラーになったらメッセージから取ればいいって結論に至りました

まずはバージョン不一致になった時のエラーがコチラ

SessionNotCreatedError
session not created: This version of ChromeDriver only supports Chrome version <ChromeDriverのメジャーバージョン>
Current browser version is <chrome.exeのバージョン> with binary path <chrome.exeのフルパス>
  (Driver info: chromedriver=<ChromeDriverのバージョン> (273bf7ac8c909cde36982d27f66f3c70846a3718-refs/branch-heads/4758@{#1151}),platform=Windows NT 10.0.19044 x86_64)

3行目にchrome.exeのバージョンがあるのでここを取ればいいわけです

SeleniumBasicのフォルダを探す

With CreateObject("Scripting.FileSystemObject")
    Select Case True
        Case .FolderExists(Environ("ProgramFiles(x86)") & "\SeleniumBasic")
            ChromeDriverPath = Environ("ProgramFiles(x86)") & "\SeleniumBasic"
        Case .FolderExists(Environ("ProgramFiles") & "\SeleniumBasic")
            ChromeDriverPath = Environ("ProgramFiles") & "\SeleniumBasic"
        Case .FolderExists(Environ("ProgramW6432") & "\SeleniumBasic")
            ChromeDriverPath = Environ("ProgramW6432") & "\SeleniumBasic"
        Case .FolderExists(Environ("LOCALAPPDATA") & "\SeleniumBasic")
            ChromeDriverPath = Environ("LOCALAPPDATA") & "\SeleniumBasic"
        Case Else
            MsgBox "'SeleniumBasic'のフォルダが見つかりません", vbCritical
            ChromeDriverCheck = False
            Exit Function
    End Select
End With

SeleniumBasicがインストールされているかの確認を含めてSeleniumBasicフォルダを探します

インストールを管理者権限で行うかどうか、管理者権限の場合はOSが32bitか64bitかでフォルダが変わるので総当たりでチェックする

エラー無視を入れてChromeDriverを起動してみる

On Error Resume Next
'---ヘッドレス状態で実行して起動成功するか試してみる
With driver
    .AddArgument ("--headless")
    .Start
End With
'---エラーになったらドラーバーを入れ替える
Select Case Err.Number
    Case 0 '---エラーにならなければSeleniumを落として終わり
        With driver
            .Close
            .Quit
        End With
    Case 33 '---SessionNotCreatedErrorを検知した時
        '------------------------------
        '中略
        '------------------------------
    Case Else '---その他エラーはメッセージをそのまま出す
        MsgBox Err.Description, vbCritical
        ChromeDriverCheck = False
        Exit Function
End Select
On Error GoTo 0

エラー発生する前提なのでOn Error Resume Nextを入れてエラー無視しながらヘッドレスモードで起動して様子を見る

エラーになるならErr.Numberは33しか有り得ないと思いつつ念のためCase Elseも入れてカバーしておく

エラーメッセージからchrome.exeのバージョンを取得する

VerDiffErr = False
'---バージョン情報を抽出するために正規表現を使う
Set objReg = CreateObject("VBScript.RegExp")
objReg.Pattern = "\d+\.\d+\.\d+" '---数字だけのマッチだからパターンだけで十分
'---エラーメッセージを分解してバージョン情報を取得する
errMsgArr = Split(Err.Description, vbLf)
For i = LBound(errMsgArr) To UBound(errMsgArr)
    Select Case True
        Case Trim(errMsgArr(i)) = "SessionNotCreatedError" '---バージョン違いエラーであることを確認
            VerDiffErr = True
        Case Trim(errMsgArr(i)) Like "Current browser version is *" '---Chromeのバージョンとパスが表示されている場合
            Set objMat = objReg.Execute(errMsgArr(i))
            ChromeVersion = objMat.Item(0)
        Case Trim(errMsgArr(i)) Like "(Driver info:*" '---ChromeDriverのバージョンが表示されている場合
            Set objMat = objReg.Execute(errMsgArr(i))
            ChromeDriverVersion = objMat.Item(0)
    End Select
Next
Set objReg = Nothing
'---ErrNumberは33なのにメッセージが違った場合
If VerDiffErr = False Then
    MsgBox Err.Description, vbCritical
    ChromeDriverCheck = False
    Exit Function
End If

まずVerDiffErr絡みは念のため書いてるけど正直不要だと思う

次に正規表現でchrome.exeのバージョン情報から「メジャー・マイナー・ビルド」部分を抜き取る（なんでリビジョンは不要と言うと後でわかる）

一応ChromeDriverのバージョンも抜き取ってはいるけど前述の通り使い道は無い、、、

ChromeDriverを置き換える

'---ChromeDriverを入れ替える前に一度落とす
With driver
    .Close
    .Quit
End With
'---入れ替えが失敗することがあるから念のため分岐しておく
If ChromeDriverUpdate(ChromeVersion) = False Then
    MsgBox "ChromeDriverの更新に失敗しました" & vbCrLf & "Excelを全て終了して再実行してください", vbCritical
    ChromeDriverCheck = False
    Exit Function
End If
'---念のためテスト運転
On Error GoTo ErrTest
With driver
    .AddArgument ("--headless")
    .Start
    .Get ("https://javeo.jp")
    .Close
    .Quit
End With
On Error GoTo 0

最初にテスト起動していたChromeDriverを落としておかないと入れ替え失敗するのでこのタイミングで

ちなみにテスト起動直後に落とすとErr.Numberがリセットされてしまうのでココがベスト（多分）

ChromeDriverUpdateは次で説明しているのでそちら参照

ChromeDriverを実際に入れ替える※ChromeDriverUpdate部分

Private Function ChromeDriverUpdate(ByVal TargetChromeDriverVersion As String) As String
'====================================================================================================
'https://chromedriver.chromium.org/ に用意されているAPIを使ってChrome.exeのバージョンに合わせたChromeDriverをダウンロードして保存する
'====================================================================================================
ChromeDriverUpdate = False
Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
Set htmlDoc = CreateObject("HTMLFile")
'Set htmlDoc = New HTMLDocument
Dim strReleaseVersion As String
With xmlhttp
    .Open "GET", "https://chromedriver.storage.googleapis.com/LATEST_RELEASE_" & TargetChromeDriverVersion '---Chromeドライバーが公開されているサイトからソースを取得
    .send
    Do While .readyState < 4
        DoEvents
    Loop
    strReleaseVersion = .responseText
    strUrl = "https://chromedriver.storage.googleapis.com/" & strReleaseVersion & "/chromedriver_win32.zip"
    URLDownloadToFile 0, strUrl, ChromeDriverPath & "\" & CheckFolder & "\" & zipFile, 0, 0 '---ファイルをダウンロードするWinAPI
    
    On Error Resume Next
    CreateObject("Scripting.FileSystemObject").DeleteFile ChromeDriverPath & "\" & "chromedriver.exe", True '---今のドライバーを削除する
    If Err.Number <> 0 Then
        ChromeDriverUpdate = False
        Exit Function
    End If
    On Error GoTo 0
    With CreateObject("Shell.Application") '---zipを既定のフォルダに向けて解凍する
        .Namespace((ChromeDriverPath)).CopyHere .Namespace((ChromeDriverPath & "\" & CheckFolder & "\" & zipFile)).Items
    End With
End With

ChromeDriverUpdate = True
Set htmlDoc = Nothing
Set xmlhttp = Nothing
End Function

実際に途中で出現するURLを叩いてもらえれば一目瞭然

ChromeDriverを管理している https://chromedriver.chromium.org/ で準備されているAPIで公開されている指定したChromeDriverの最新バージョンが取得できる

このAPIで渡すLATEST_RELEASE_の後ろに続く値は「メジャー」だけか「メジャー・マイナー・ビルド」のどちらかなので事前取得でリビジョンは抜いていたんですね

で、このバージョン情報があればのURLでChromeDriverをダウンロードできる

余談

ここで思い返してほしいのがChrome.exeのバージョンはリビジョンまで取れていたのにわざわざビルドまでにしてAPIで最新のバージョンを取得したのか・・・

ここが少しややこしくなる話でChromeDriverは全てのChrome.exeのバージョンが準備されているわけではないってことと、リビジョンが違うだけならエラーにならないので”なるべく新しい”レベルで更新すれば動くのでこの手順でやっています

あとがき

この時点で前回よりソースが短くなっていてもう少し削れる部分があるので結構スッキリできたかなと

エラー発生ありきなのが気に入らない点ではあるものの個人的には今回の方がオススメですね

スポンサーリンク

コメント

  1. tấm compact cdf より:
    2022-12-30 13:21

    It’s an amazing post designed for all the internet people;
    they will get advantage from it I am sure.

    返信
タイトルとURLをコピーしました