VBAでChromeDriverを自動更新する

2022.02.21

2022/04/02 ドライバー取得部分のソースを変更しました

このページにあるソースはWindows OSを前提にしています

毎回チェックするのは面倒だしエラー発生するのも嫌なので自動更新プログラムです

ChromeとChromeDriverのバージョン違い

SeleniumのChromeDriverを使っている人は必ずと言っていいほどぶち当たる憎きChromeDriverのバージョン違いによるエラー

VBAの実行時エラー

Chromeは初期設定だと自動でバージョンアップしてくれるので気づかないうちにChromeDriverの方が古くなって忘れた頃にエラーが発生してイラっとくる

まだ自分で使う上ではドライバー更新すればいいんだけど一番困るのがクラウドソーシングとかで誰かに渡したファイルでこのエラーが起こると説明しても伝わらない時、、、

ココのサイトでChromeのバージョンと同じドライバーをダウンロードしてもろて

Chromeのバージョンってどこ見ればわかるのさ

（Google先生に聞いてよ・・・）

ダウンロードしたドライバーをSeleniumBasicのフォルダに移動してもろて

そんなフォルダどこにあるかわからん

（インストールした時に表示されてたやん・・・）

ってやり取りがありがちなので勝手にChromeDriverをダウンロードして更新してくれるモジュールを作りました！

適当なモジュールにソースを貼ってメインモジュールの最初にCallで呼んであげればChromeとChromeDriverのバージョン比較してダウンロード＆展開してくれます

私はこれで運用できてますが、うまく動かないことがあれば一報いただけると修正加筆します

モジュール

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

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 GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _
                         (ByVal lpApplicationName As String, _
                          ByVal lpKeyName As Any, _
                          ByVal lpDefault As String, _
                          ByVal lpReturnedString As String, _
                          ByVal nSize As Long, _
                          ByVal lpFileName As String) As Long
                           
Private Declare PtrSafe Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" _
                         (ByVal lpApplicationName As String, _
                          ByVal lpKeyName As Any, _
                          ByVal lpString As Any, _
                          ByVal lpFileName As String) As Long
                           
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 Const ConfigFile As String = "config.ini"
Private Const SecName As String = "ChromeDriver" '---セクション名
Private Const KeyName As String = "ChromeVersion" '---キー名
Private Const Default As String = "1.0.0.0" '---デフォルト値

Private Type VersionClass '---本当はクラスオブジェクトにしたいけどこれだけのためにモジュール作りたくない
    Major As Long
    Minor As Long
    Build As Long
    Revision As Long
    strVersion As String
End Type

Private RtnCD As Long
Private RtnStr As String
 
Private intFF As Long
Private strUrl As String
 
Private ChromeVersion As VersionClass
Private ChromePath As String '---Chrome.exeが保存されているパス
Private ChromeDriverVersion As VersionClass
Private ChromeDriverPath As String '---ChromeDriverが保存されているパス
 
Private objFso As Object ' Scripting.FileSystemObject '--- 「Microsoft Scripting Runtime」の参照設定を有効にしておく
Private objFolder As Object 'Scripting.Folder
Private objRE As Object ' RegExp '--- 「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 element As Object 'HTMLLIElement
 
Private Const CheckFolder As String = "drivercheck"
Private Const zipFile As String = "howa1.zip"
Public Function ChromeDriverVersionCheck()
'====================================================================================================
'ChromeDriverを自動更新する
'====================================================================================================
Set objFso = CreateObject("Scripting.FileSystemObject")
'---SeleniumBasicのフォルダを探す
Select Case True
    Case objFso.FolderExists(Environ("ProgramFiles(x86)") & "\SeleniumBasic")
        ChromeDriverPath = Environ("ProgramFiles(x86)") & "\SeleniumBasic"
    Case objFso.FolderExists(Environ("ProgramFiles") & "\SeleniumBasic")
        ChromeDriverPath = Environ("ProgramFiles") & "\SeleniumBasic"
    Case objFso.FolderExists(Environ("ProgramW6432") & "\SeleniumBasic")
        ChromeDriverPath = Environ("ProgramW6432") & "\SeleniumBasic"
    Case objFso.FolderExists(Environ("LOCALAPPDATA") & "\SeleniumBasic")
        ChromeDriverPath = Environ("LOCALAPPDATA") & "\SeleniumBasic"
    Case Else
        MsgBox "'SeleniumBasic'のフォルダが見つかりません", vbCritical
        Exit Function
End Select
'---Chrome本体のフォルダを探す
Select Case True
    Case objFso.FolderExists(Environ("ProgramFiles(x86)") & "\Google\Chrome\Application")
        ChromePath = Environ("ProgramFiles(x86)") & "\Google\Chrome\Application"
    Case objFso.FolderExists(Environ("ProgramFiles") & "\Google\Chrome\Application")
        ChromePath = Environ("ProgramFiles") & "\Google\Chrome\Application"
    Case objFso.FolderExists(Environ("ProgramW6432") & "\Google\Chrome\Application")
        ChromePath = Environ("ProgramW6432") & "\Google\Chrome\Application"
    Case objFso.FolderExists(Environ("LOCALAPPDATA") & "\Google\Chrome\Application")
        ChromePath = Environ("LOCALAPPDATA") & "\Google\Chrome\Application"
    Case Else
        MsgBox "'Chrome'フォルダが見つかりません", vbCritical
        Exit Function
End Select
 
Set objFso = Nothing
With ChromeVersion
    .Major = 1
    .Minor = 0
    .Build = 0
    .Revision = 0
End With
Call GetChromeVersion(ChromeVersion.Major, ChromeVersion.Minor, ChromeVersion.Build, ChromeVersion.Revision, ChromeVersion.strVersion) '---Chrome.exeのバージョンを取得する
Call GetChromeDriverVersion(ChromeDriverVersion.Major, ChromeDriverVersion.Minor, ChromeDriverVersion.Build, ChromeDriverVersion.Revision, ChromeDriverVersion.strVersion) '---ChromeDriverのバージョンを取得する
If ChromeVersion.Major > ChromeDriverVersion.Major Then '---メジャーが更新されていたら
    Call UpdateChromeChromeDriver(Join(Array(ChromeVersion.Major, ChromeVersion.Minor, ChromeVersion.Build), "."), ChromeDriverVersion.Revision)
    RtnCD = WritePrivateProfileString(SecName, KeyName, ChromeDriverVersion.strVersion, ChromeDriverPath & "\" & ConfigFile) '---iniを上書きする

ElseIf ChromeVersion.Minor > ChromeDriverVersion.Minor Then '---マイナ―が更新されていたら
    Call UpdateChromeChromeDriver(Join(Array(ChromeVersion.Major, ChromeVersion.Minor, ChromeVersion.Build), "."), ChromeDriverVersion.Revision)
    RtnCD = WritePrivateProfileString(SecName, KeyName, ChromeDriverVersion.strVersion, ChromeDriverPath & "\" & ConfigFile) '---iniを上書きする

ElseIf ChromeVersion.Build > ChromeDriverVersion.Build Then '---ビルドが更新されていたら
    Call UpdateChromeChromeDriver(Join(Array(ChromeVersion.Major, ChromeVersion.Minor, ChromeVersion.Build), "."), ChromeDriverVersion.Revision)
    RtnCD = WritePrivateProfileString(SecName, KeyName, ChromeDriverVersion.strVersion, ChromeDriverPath & "\" & ConfigFile) '---iniを上書きする

ElseIf ChromeVersion.Revision > ChromeDriverVersion.Revision Then '---リビジョンが更新されていたら
    Call UpdateChromeChromeDriver(Join(Array(ChromeVersion.Major, ChromeVersion.Minor, ChromeVersion.Build), "."), ChromeVersion.Revision)
    RtnCD = WritePrivateProfileString(SecName, KeyName, ChromeDriverVersion.strVersion, ChromeDriverPath & "\" & ConfigFile) '---iniを上書きする
End If
End Function
Private Function GetChromeVersion(ByRef Major As Long, ByRef Minor As Long, ByRef Build As Long, ByRef Revision As Long, ByRef strVersion As String)
'====================================================================================================
'Chrome.exeと同じフォルダにバージョン名のフォルダがあるのでそこからバージョンを取得する
'====================================================================================================
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objRE = CreateObject("VBScript.RegExp")
 
With objRE '---正規表現の準備
    .Pattern = "([0-9]+(?=\.))"
    .Global = True
End With
For Each objFolder In objFso.GetFolder(ChromePath).SubFolders
    If objRE.Test(objFolder.Name) Then '---正規表現でフォルダ名をマッチさせてバージョンを取得する
        strVersion = objFolder.Name
        If Major < CLng(Split(strVersion, ".")(0)) Then
            Major = CLng(Split(strVersion, ".")(0))
            Minor = CLng(Split(strVersion, ".")(1))
            Build = CLng(Split(strVersion, ".")(2))
            Revision = CLng(Split(strVersion, ".")(3))
        ElseIf Minor < CLng(Split(strVersion, ".")(1)) Then
            Minor = CLng(Split(strVersion, ".")(1))
            Build = CLng(Split(strVersion, ".")(2))
            Revision = CLng(Split(strVersion, ".")(3))
        ElseIf Build < CLng(Split(strVersion, ".")(2)) Then
            Build = CLng(Split(strVersion, ".")(2))
            Revision = CLng(Split(strVersion, ".")(3))
        ElseIf Revision < CLng(Split(strVersion, ".")(3)) Then
            Revision = CLng(Split(strVersion, ".")(3))
        End If
    End If
Next objFolder
 
Set objRE = Nothing
Set objFso = Nothing
End Function
Private Function GetChromeDriverVersion(ByRef Major As Long, ByRef Minor As Long, ByRef Build As Long, ByRef Revision As Long, ByRef strVersion As String)
'====================================================================================================
'ChromeDriverと同じフォルダにconfig.iniを保存してバージョンを管理して取得する
'====================================================================================================
Set objFso = CreateObject("Scripting.FileSystemObject")
 
If objFso.FileExists(ChromeDriverPath & "\" & ConfigFile) Then
    strVersion = ReadIni(ChromeDriverPath & "\" & ConfigFile, SecName, KeyName, Default)
    Major = CLng(Split(strVersion, ".")(0))
    Minor = CLng(Split(strVersion, ".")(1))
    Build = CLng(Split(strVersion, ".")(2))
    Revision = CLng(Split(strVersion, ".")(3))
Else '---config.iniが無いなら作る
    GetChromeDriverVersion = Default '---初期値
    intFF = FreeFile
    Open ChromeDriverPath & "\" & ConfigFile For Output As #intFF
        Major = 1
        Minor = 0
        Build = 0
        Revision = 0
        strVersion = Default
        Print #intFF, "[ChromeDriver]"
        Print #intFF, "ChromeVersion = " & Default
    Close
End If
 
If objFso.FolderExists(ChromeDriverPath & "\" & CheckFolder) = False Then '---zip保存用フォルダが無かったら作成しておく
    objFso.CreateFolder ChromeDriverPath & "\" & CheckFolder
End If
Set objFso = Nothing
End Function
Private Function UpdateChromeChromeDriver(ByVal TargetChromeDriverVersion As String, ByRef Revision As Long)
'====================================================================================================
'https://chromedriver.chromium.org/downloadsのソースを分解してChromeのバージョンに合わせたChromeDriverをダウンロードして保存する
'====================================================================================================
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
    Application.DisplayAlerts = False
    Kill ChromeDriverPath & "\" & "chromedriver.exe" '---今のドライバーを削除する
    With CreateObject("Shell.Application") '---zipを既定のフォルダに向けて解凍する
        .Namespace((ChromeDriverPath)).CopyHere .Namespace((ChromeDriverPath & "\" & CheckFolder & "\" & zipFile)).Items
    End With
    Application.DisplayAlerts = True
    On Error GoTo 0
End With
 
Set htmlDoc = Nothing
Set xmlhttp = Nothing
End Function
Private Function ReadIni(ByVal FName As String, ByVal SName As String, ByVal KName As String, ByVal Default As String) As String
'====================================================================================================
'WinAPIでiniファイルから情報を取得する
'====================================================================================================
RtnStr = Space$(256)
RtnCD = GetPrivateProfileString(SName, KName, Default, RtnStr, 255, FName)
     
' 戻り値設定
If RtnCD > 0 Then
    If InStr(RtnStr, Chr$(0)) > 0 Then
        ReadIni = Left$(RtnStr, InStr(RtnStr, Chr$(0)) - 1)
    Else
        ReadIni = ""
    End If
Else
    ReadIni = Default
End If
End Function

このページを含むSeleniumBasicの使い勝手を良くするプロシージャをまとめて一つのモジュールにしたページを作ったので↓↓↓へどうぞ

【ソースだけ】SeleniumBasicの使い勝手を良くするモジュール
このモジュールを入れておけばSeleniumBasicを使ったプログラム作りが捗るはず！と言っても個別で紹介したソースをひとまとめにしたコピペ用なイメージなのでそれぞれの使い方とかソースは各リンクからどうぞ何か思いついたらどんどん追加してい...
javeo.jp
2022.12.06
スポンサーリンク

コメント

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