VBA用の自作関数(Selenium)

モジュールは一番最後に全部まとめたものを貼っています

SeleniumBasicを使う上で「こんな機能・関数があったら便利なのにな~」ってのを作りました

実際に自分でSeleniumBasicを使ったツールを作る時は必ず入れて不定期アップデートしているので適当なタイミングで見に来てください

SeleniumOpen

Akamaiが比較的有名なキーワードですがSeleniumが使えないサイトがあって、その対応で作ったSelenium起動関数

具体的にはなぜかログイン処理などが永遠と終わらないサイトとかに使えない場合に使える他、Chromeがバージョン100になってなぜかエラーになりがちなGetでページ遷移も比較的安定する気がする

SeleniumClose

「SeleniumOpen」とセット

ソースを見ればわかる、単純にドライバを落とした後に一時プロファイルフォルダも削除するだけ


ここから先の「○○と○○Elm」は要素の指定の仕方が違うだけで動きは同じ
※結局○○Elmの方を実行することになるので

ViewCheckとViewCheckElm

画面上の要素の有無を確認する関数

引数でモード分けしていてソース上に存在しているか、画面上に見えているか、活性化しているかの3段階で判定できるようにしている

以降の関数も同じことを前処理に入れているのでこれだけで使うことは多分少ない

InputTextとInputTextElm

Seleniumの文字入力は「SendKeys」の追記型なので一度クリアしてあげる処理やJavaScriptで活性化処理が入るページのために活性化待ちしたりする処理を入れている

後はカーソルアウトすると発火するJavaScriptが仕込んであるページも良く見かけるのでTabキーを押してカーソルアウトしてあげる親切設計

InputTextScript

どんな理屈かまで調べてないけどなぜか「Clear」コマンドが効かないInputがあって、↑の「InputText」では思い通りの動きにならないのでやむを得ずJavaScriptで強制更新するやつ

多分レアケースなのでわざわざ関数にしなくても個別対応でいいじゃんと思いつつ、入力前の活性化チェックや入力後のカーソルアウトをしたいから関数にした

GetTextとGetTextElm

GetTextと言いつつValueとかタグ内の情報を取得できるようにAttributeも見るように作った

よくあるケースはaタグのhrefからリンク先URLを取ったり、data-○○とかに入ってる情報を取りたいことがあるので意外と便利

ButtonClickとButtonClickElm

クリックする手前で他の関数と同じようにチェックする以外はただクリックするだけ

ChromeDriverVersionCheck

これが一番大事

結論から言うとChromeDriverを自動更新する関数

Pythonにあるモジュールを解析してVBA用にアレンジを加えていて、最初にこの関数を呼び出すだけでバージョン不一致エラーのイライラから解放される

特にツールを提供する時に

Chromeのバージョンが上がったらChromeDriverのバージョンも上げないと行けなくて、このサイトからダウンロードしてそれをこのフォルダにコピーして・・・

とか説明面倒だしリテラシー低い人だと伝わらないしってことがあるのでわかってくれる人には感動レベル(なはず)

実際のモジュール

'モジュール名は「SeleniumAssistance」で登録してください
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 i As Long
Private pathArr As Variant
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 NewDriverVersion As String
 
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"

Private profile As String
Private Keys As New Selenium.Keys
Private lp As Long
Private Const defWaitMS As Long = 500
Private Const LpWaitCnt As Long = 30
Public Function SeleniumOpen(ByRef driver As Selenium.ChromeDriver) As Boolean
'====================================================================================================
'普通にChromeを立ち上げて後からChromeDriverで掴みに行く
'====================================================================================================
Select Case True
    Case Len(Environ("TMP")) > 0
        profile = Environ("TMP") & "\userdata"
    Case Len(Environ("TEMP"))
        profile = Environ("TEMP") & "\userdata"
    Case Else
        profile = ThisWorkbook.Path & "\userdata"
End Select
On Error Resume Next '---プロセスファイルを掴んでいる場合はスキップする
With CreateObject("Scripting.FileSystemObject")
    If .FolderExists(profile) = True Then '---一時プロファイル用にフォルダがあれば削除
        .DeleteFolder profile
    End If
    .CreateFolder profile '---一時プロファイル用にフォルダを作る
End With
CreateObject("WScript.Shell").Run ("chrome.exe --remote-debugging-port=9222 --user-data-dir=""" & profile & "")
On Error GoTo 0
driver.SetCapability "debuggerAddress", "127.0.0.1:9222"
End Function
Public Function SeleniumClose(ByRef driver As Selenium.ChromeDriver) As Boolean
'====================================================================================================
'Chromeを落としつつ一時プロファイルフォルダを削除する
'====================================================================================================
On Error Resume Next
driver.Close
driver.Quit
With CreateObject("Scripting.FileSystemObject")
    If .FolderExists(profile) = True Then
        .DeleteFolder profile
    End If
End With
On Error GoTo 0
Set driver = Nothing
End Function
Public Function ViewCheck(ByVal driver As Selenium.WebDriver, ByVal by As Selenium.by, Optional CheckMode As Long = 0, Optional ByVal Index As Long = 1) As Boolean
If driver.FindElements(by).Count > 0 Then
    ViewCheck = ViewCheckElm(driver, driver.FindElements(by)(Index), CheckMode)
Else
    ViewCheck = False
End If
End Function
Public Function ViewCheckElm(ByVal driver As Selenium.WebDriver, element As Selenium.WebElement, Optional CheckMode As Long = 0) As Boolean
'==============================
'CheckMode
'0:活性化しているかまで
'1:画面上に表示されているかまで
'2:DOMに存在しているかまで
'==============================
On Error GoTo ErrEnd
With element
    For lp = 1 To LpWaitCnt '---要素が存在するかチェック※待機秒数はLpWaitCntで指定
        If .IsPresent = True Then
            Exit For
        Else
            DoEvents
            driver.Wait 1000 '---1秒待機
        End If
    Next
    If .IsPresent = False Then '---ループを抜けても要素が見つからないと言うことは失敗扱い
        ViewCheckElm = False
        Exit Function
    End If
    
    If CheckMode <= 1 Then
        For lp = 1 To LpWaitCnt '---要素が見えているかチェック※待機秒数はLpWaitCntで指定
            If .IsDisplayed = True Then
                Exit For
            Else
                DoEvents
                driver.Wait 1000 '---1秒待機
            End If
        Next
        If .IsDisplayed = False Then '---ループを抜けても見つからないと言うことは失敗扱い
            ViewCheckElm = False
            Exit Function
        End If
    End If
    
    If CheckMode <= 2 Then
        If .IsEnabled = False Then '---活性化しているかチェック
            ViewCheckElm = False
            Exit Function
        End If
    End If
End With
ViewCheckElm = True
On Error GoTo 0
Exit Function
ErrEnd:
ViewCheckElm = False
Debug.Print Err.Description
End Function
Public Function InputText(ByVal driver As Selenium.WebDriver, ByVal by As Selenium.by, ByVal str As String, Optional ByVal Index As Long = 1, Optional WaitMS = defWaitMS) As Boolean
'====================================================================================================
'InputTextElmの亜種
'====================================================================================================
If driver.FindElements(by).Count > 0 Then
    InputText = InputTextElm(driver, driver.FindElements(by)(Index), str, WaitMS)
Else
    InputText = False
End If
End Function
Public Function InputTextElm(ByVal driver As Selenium.WebDriver, element As Selenium.WebElement, ByVal str As String, Optional WaitMS = defWaitMS) As Boolean
'====================================================================================================
'文字入力を色々考慮しながらやる
'====================================================================================================
On Error GoTo ErrEnd
With element
    For lp = 1 To LpWaitCnt '---要素が存在するかチェック※待機秒数はLpWaitCntで指定
        driver.Timeouts.ImplicitWait = 30
        If .IsPresent = True Then
            Exit For
        Else
            DoEvents
            driver.Wait 1000 '---1秒待機
        End If
    Next
    If .IsPresent = False Then '---ループを抜けても要素が見つからないと言うことは失敗扱い
        InputTextElm = False
        Exit Function
    End If
    
    For lp = 1 To LpWaitCnt '---要素が見えているかチェック※待機秒数はLpWaitCntで指定
        If .IsDisplayed = True Then
            Exit For
        Else
            DoEvents
            driver.Wait 1000 '---1秒待機
        End If
    Next
    If .IsDisplayed = False Then '---ループを抜けても見つからないと言うことは失敗扱い
        InputTextElm = False
        Exit Function
    End If
    
    If .IsEnabled = False Then '---活性化しているかチェック
        InputTextElm = False
        Exit Function
    End If
    
    focusToElement driver, element
    .Click '---念のためクリックしてアクティブにする
    .Clear '---クリアしないと追記されてしまう
    driver.Wait 100 '---稀にクリア直後に入力すると失敗することがあるので0.1秒だけ待機
    .SendKeys str
    .SendKeys Keys.Tab '---カーソルアウトで発火するJavaScript対策
    driver.Wait WaitMS '---規定秒数待機
End With
InputTextElm = True
On Error GoTo 0
Exit Function
ErrEnd:
InputTextElm = False
Debug.Print Err.Description
End Function
Public Function InputTextScript(ByVal driver As Selenium.WebDriver, cssselectors As String, ByVal str As String, Optional ByVal Index As Long = 0, Optional WaitMS = defWaitMS) As Boolean
'====================================================================================================
'文字入力を色々考慮しながらやる ※Clearが効かないサイトがあるのでJavaScriptで実行する時用
'====================================================================================================
On Error GoTo ErrEnd
Dim element As Selenium.WebElement
Set element = driver.FindElementsByCss(cssselectors)(Index + 1)
With element
    For lp = 1 To LpWaitCnt '---要素が存在するかチェック※待機秒数はLpWaitCntで指定
        driver.Timeouts.ImplicitWait = 30
        If .IsPresent = True Then
            Exit For
        Else
            DoEvents
            driver.Wait 1000 '---1秒待機
        End If
    Next
    If .IsPresent = False Then '---ループを抜けても要素が見つからないと言うことは失敗扱い
        InputTextScript = False
        Exit Function
    End If
    
    For lp = 1 To LpWaitCnt '---要素が見えているかチェック※待機秒数はLpWaitCntで指定
        If .IsDisplayed = True Then
            Exit For
        Else
            DoEvents
            driver.Wait 1000 '---1秒待機
        End If
    Next
    If .IsDisplayed = False Then '---ループを抜けても見つからないと言うことは失敗扱い
        InputTextScript = False
        Exit Function
    End If
    
    If .IsEnabled = False Then '---活性化しているかチェック
        InputTextScript = False
        Exit Function
    End If
    
    driver.ExecuteScript ("document.querySelectorAll('" & cssselectors & "')[" & Index & "].value='" & str & "'") '---JavaScriptで文字入力
    .SendKeys Keys.Tab '---カーソルアウトで発火するJavaScript対策
    driver.Wait WaitMS '---規定秒数待機
End With
InputTextScript = True
Set element = Nothing
On Error GoTo 0
Exit Function
ErrEnd:
InputTextScript = False
Debug.Print Err.Description
Set element = Nothing
End Function
Public Function GetText(ByVal driver As Selenium.WebDriver, ByVal by As Selenium.by, Optional TargetAttr As String = "default", Optional ByVal Index As Long = 1) As String
'====================================================================================================
'GetTextElmの亜種
'====================================================================================================
If driver.FindElements(by).Count > 0 Then
    GetText = GetTextElm(driver, driver.FindElements(by)(Index), TargetAttr)
Else
    GetText = False
End If
End Function
Public Function GetTextElm(ByVal driver As Selenium.WebDriver, element As Selenium.WebElement, Optional TargetAttr As String = "default") As String
'====================================================================================================
'データ取得をText以外からもできるようにしている
'====================================================================================================
On Error GoTo ErrEnd
With element
    For lp = 1 To LpWaitCnt '---要素が存在するかチェック※待機秒数はLpWaitCntで指定
        If .IsPresent = True Then
            Exit For
        Else
            DoEvents
            driver.Wait 1000 '---1秒待機
        End If
    Next
    If .IsPresent = False Then '---ループを抜けても要素が見つからないと言うことは失敗扱い
        GetTextElm = vbNullString
        Exit Function
    End If
        
    Select Case LCase(TargetAttr) '---属性指定で取得できるようにする
        Case "default"
            GetTextElm = .Text '---textの取得が基本
            If Len(Trim(GetTextElm)) = 0 Then '---よく使いそうなValueはデフォルトでも補完対象にしておく
                GetTextElm = .Value
            End If
        Case "text" '---明示的にtextを指定するならValueは考慮しない
            GetTextElm = .Text
        Case Else
            GetTextElm = .Attribute(TargetAttr)
    End Select
End With
On Error GoTo 0
Exit Function
ErrEnd:
GetTextElm = vbNullString
Debug.Print Err.Description
End Function
Public Function ButtonClick(driver As Selenium.WebDriver, by As Selenium.by, Optional Index As Long = 1, Optional WaitMS = defWaitMS) As Boolean
'====================================================================================================
'ButtonClickElmの亜種
'====================================================================================================
If driver.FindElements(by).Count > 0 Then
    ButtonClick = ButtonClickElm(driver, driver.FindElements(by)(Index), WaitMS)
Else
    ButtonClick = False
End If
End Function
Public Function ButtonClickElm(driver As Selenium.WebDriver, element As Selenium.WebElement, Optional WaitMS = defWaitMS) As Boolean
'====================================================================================================
'ボタンクリックを色々考慮しながらやる
'====================================================================================================
On Error GoTo ErrEnd
With element
    For lp = 1 To LpWaitCnt '---要素が存在するかチェック※待機秒数はLpWaitCntで指定
        If .IsPresent = True Then
            Exit For
        Else
            DoEvents
            driver.Wait 1000 '---1秒待機
        End If
    Next
    If .IsPresent = False Then '---ループを抜けても要素が見つからないと言うことは失敗扱い
        ButtonClickElm = False
        Exit Function
    End If
    
    For lp = 1 To LpWaitCnt '---要素が見えているかチェック※待機秒数はLpWaitCntで指定
        If .IsDisplayed = True Then
            Exit For
        Else
            DoEvents
            driver.Wait 1000 '---あえて変数ではなくて1秒待機で固定している
        End If
    Next
    If .IsDisplayed = False Then '---ループを抜けても見つからないと言うことは失敗扱い
        ButtonClickElm = False
        Exit Function
    End If
    
    If .IsEnabled = False Then '---活性化しているかチェック
        ButtonClickElm = False
        Exit Function
    End If
    .Click
    driver.Wait WaitMS '---規定秒数待機
End With
ButtonClickElm = True
On Error GoTo 0
Exit Function
ErrEnd:
ButtonClickElm = False
Debug.Print Err.Description
End Function
Public Function ChromeDriverVersionCheck() As Boolean
'====================================================================================================
'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, ChromeDriverVersion.strVersion) '---Chrome.exeのバージョンを取得する
Call GetChromeDriverVersion(ChromeDriverVersion.Major, ChromeDriverVersion.Minor, ChromeDriverVersion.Build, ChromeDriverVersion.Revision, ChromeDriverVersion.strVersion) '---ChromeDriverのバージョンを取得する
If ChromeVersion.Major > ChromeDriverVersion.Major Then '---メジャーが更新されていたら
    NewDriverVersion = UpdateChromeChromeDriver(Join(Array(ChromeVersion.Major, ChromeVersion.Minor, ChromeVersion.Build), "."), ChromeDriverVersion.Revision)
    RtnCD = WritePrivateProfileString(SecName, KeyName, NewDriverVersion, ChromeDriverPath & "\" & ConfigFile) '---iniを上書きする

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

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

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

'---テスト運転
On Error GoTo ErrTest
With CreateObject("Selenium.ChromeDriver")
    .AddArgument ("--headless")
    .Start
    .Get ("https://javeo.jp")
    .Close
    .Quit
End With
ChromeDriverVersionCheck = True
Exit Function
ErrTest:
    MsgBox "ChromeDriverの起動に失敗しました", vbCritical
    ChromeDriverVersionCheck = False
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) As String
'====================================================================================================
'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
    If CLng(Split(strReleaseVersion, ".")(3)) > Revision Then '---リビジョンだけだと更新版がない可能性がある
        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 If
End With

UpdateChromeChromeDriver = strReleaseVersion
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
Public Function focusToElement(ByVal driver As Selenium.WebDriver, ByVal element As Selenium.WebElement)
'====================================================================================================
'指定した要素にスクロールさせる
'====================================================================================================
Dim Actions As Selenium.Actions
Set Actions = driver.Actions.MoveToElement(element)
Actions.Perform
Set Actions = Nothing
End Function

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