モジュールは一番最後に全部まとめたものを貼っています
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 Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
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 ViewCheck(ByVal driver As Selenium.WebDriver, ByVal By As Selenium.By, Optional CheckMode As Long = 0, Optional ByVal Index As Long = 1, Optional TotalWaitSec As Long = 30) As Boolean
RemainingSec = TotalWaitSec
Do While RemainingSec > 0 '---要素が存在するかチェック
If driver.FindElements(By).Count >= Index Then
ViewCheck = ViewCheckElm(driver, driver.FindElements(By)(Index), CheckMode, RemainingSec)
Exit Function
End If
driver.Wait 1000
RemainingSec = RemainingSec - 1
Loop
ViewCheck = False
End Function
Public Function ViewCheckElm(ByVal driver As Selenium.WebDriver, element As Selenium.WebElement, Optional CheckMode As Long = 0, Optional TotalWaitSec As Long = 30) As Boolean
'==============================
'CheckMode
'0:活性化しているかまで
'1:画面上に表示されているかまで
'2:DOMに存在しているかまで
'==============================
On Error GoTo ErrEnd
RemainingSec = TotalWaitSec
With element
Do While RemainingSec > 0 '---要素が存在するかチェック
If .IsPresent = True Then
Exit Do
Else
DoEvents
driver.Wait 1000 '---1秒待機
End If
RemainingSec = RemainingSec - 1
Loop
If .IsPresent = False Then '---ループを抜けても要素が見つからないと言うことは失敗扱い
ViewCheckElm = False
Exit Function
End If
If CheckMode <= 1 Then
Do While RemainingSec > 0 '---要素が見えているかチェック
If .IsDisplayed = True Then
Exit Do
Else
DoEvents
driver.Wait 1000 '---1秒待機
End If
RemainingSec = RemainingSec - 1
Loop
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 AppendMode As Boolean = False, Optional ByVal Index As Long = 1, Optional WaitMS = defWaitMS, Optional TotalWaitSec As Long = 30, Optional ClearWaitMS As Long = 500) As Boolean
'====================================================================================================
'InputTextElmの亜種
'====================================================================================================
If driver.FindElements(By).Count > 0 Then
InputText = InputTextElm(driver, driver.FindElements(By)(Index), str, AppendMode, WaitMS, TotalWaitSec)
Else
InputText = False
End If
End Function
Public Function InputTextElm(ByVal driver As Selenium.WebDriver, element As Selenium.WebElement, ByVal str As String, Optional AppendMode As Boolean = False, Optional WaitMS = defWaitMS, Optional TotalWaitSec As Long = 30, Optional ClearWaitMS As Long = 500) As Boolean
'====================================================================================================
'文字入力を色々考慮しながらやる
'====================================================================================================
On Error GoTo ErrEnd
RemainingSec = TotalWaitSec
With element
Do While RemainingSec > 0 '---要素が存在するかチェック
driver.Timeouts.ImplicitWait = 30
If .IsPresent = True Then
Exit Do
Else
DoEvents
driver.Wait 1000 '---1秒待機
End If
RemainingSec = RemainingSec - 1
Loop
If .IsPresent = False Then '---ループを抜けても要素が見つからないと言うことは失敗扱い
InputTextElm = False
Exit Function
End If
Do While RemainingSec > 0 '---要素が見えているかチェック
If .IsDisplayed = True Then
Exit Do
Else
DoEvents
driver.Wait 1000 '---1秒待機
End If
RemainingSec = RemainingSec - 1
Loop
If .IsDisplayed = False Then '---ループを抜けても見つからないと言うことは失敗扱い
InputTextElm = False
Exit Function
End If
If .IsEnabled = False Then '---活性化しているかチェック
InputTextElm = False
Exit Function
End If
focusToElement driver, element
.Click '---念のためクリックしてアクティブにする
If AppendMode = False Then '---追記モード判定
.Clear '---クリアしないと追記されてしまう
End If
driver.Wait ClearWaitMS '---稀にクリア直後に入力すると失敗することがあるので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, Optional TotalWaitSec As Long = 30) As Boolean
'====================================================================================================
'文字入力を色々考慮しながらやる ※Clearが効かないサイトがあるのでJavaScriptで実行する時用
'====================================================================================================
On Error GoTo ErrEnd
Dim element As Selenium.WebElement
Set element = driver.FindElementsByCss(cssselectors)(Index + 1)
With element
driver.Timeouts.ImplicitWait = 30
RemainingSec = TotalWaitSec
Do While RemainingSec > 0 '---要素が存在するかチェック
If .IsPresent = True Then
Exit Do
Else
DoEvents
driver.Wait 1000 '---1秒待機
End If
RemainingSec = RemainingSec - 1
Loop
If .IsPresent = False Then '---ループを抜けても要素が見つからないと言うことは失敗扱い
InputTextScript = False
Exit Function
End If
Do While RemainingSec > 0 '---要素が見えているかチェック
If .IsDisplayed = True Then
Exit Do
Else
DoEvents
driver.Wait 1000 '---1秒待機
End If
RemainingSec = RemainingSec - 1
Loop
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, Optional TotalWaitSec As Long = 30) As String
'====================================================================================================
'GetTextElmの亜種
'====================================================================================================
If driver.FindElements(By).Count > 0 Then
GetText = GetTextElm(driver, driver.FindElements(By)(Index), TargetAttr, TotalWaitSec)
Else
GetText = False
End If
End Function
Public Function GetTextElm(ByVal driver As Selenium.WebDriver, element As Selenium.WebElement, Optional TargetAttr As String = "default", Optional TotalWaitSec As Long = 30) As String
'====================================================================================================
'データ取得をText以外からもできるようにしている
'====================================================================================================
On Error GoTo ErrEnd
With element
RemainingSec = TotalWaitSec
Do While RemainingSec > 0 '---要素が存在するかチェック※待機秒数はLpWaitCntで指定
If .IsPresent = True Then
Exit Do
Else
DoEvents
driver.Wait 1000 '---1秒待機
End If
RemainingSec = RemainingSec - 1
Loop
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
GetTextElm = Trim(GetTextElm)
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, Optional TotalWaitSec As Long = 30) As Boolean
'====================================================================================================
'ButtonClickElmの亜種
'====================================================================================================
If driver.FindElements(By).Count > 0 Then
ButtonClick = ButtonClickElm(driver, driver.FindElements(By)(Index), WaitMS, TotalWaitSec)
Else
ButtonClick = False
End If
End Function
Public Function ButtonClickElm(driver As Selenium.WebDriver, element As Selenium.WebElement, Optional WaitMS = defWaitMS, Optional TotalWaitSec As Long = 30) As Boolean
'====================================================================================================
'ボタンクリックを色々考慮しながらやる
'====================================================================================================
On Error GoTo ErrEnd
With element
RemainingSec = TotalWaitSec
Do While RemainingSec > 0 '---要素が存在するかチェック※待機秒数はLpWaitCntで指定
If .IsPresent = True Then
Exit Do
Else
DoEvents
driver.Wait 1000 '---1秒待機
End If
RemainingSec = RemainingSec - 1
Loop
If .IsPresent = False Then '---ループを抜けても要素が見つからないと言うことは失敗扱い
ButtonClickElm = False
Exit Function
End If
Do While RemainingSec > 0 '---要素が見えているかチェック※待機秒数はLpWaitCntで指定
If .IsDisplayed = True Then
Exit Do
Else
DoEvents
driver.Wait 1000 '---あえて変数ではなくて1秒待機で固定している
End If
RemainingSec = RemainingSec - 1
Loop
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
Public Function RegExpFunc(Target As String, strPattern As String, Optional Idx As Long = 0, Optional strDelimiter As String = "") As String
'====================================================================================================
'正規表現の結果を返す
'====================================================================================================
'Dim objReg As New VBScript_RegExp_55.RegExp '---参照設定してればこれでもok
'Dim objMatchColl As VBScript_RegExp_55.MatchCollection '---参照設定してればこれでもok
'Dim objMatch As VBScript_RegExp_55.Match '---参照設定してればこれでもok
Dim objReg As Object
Dim objMatchColl As Object
Dim objMatch As Object
Set objReg = CreateObject("VBScript.RegExp")
With objReg
.Pattern = strPattern '---正規表現のパターン
.IgnoreCase = False '---大文字小文字の区別をする
.Global = True '---複数回マッチした場合は全て取得する
Set objMatchColl = .Execute(Target)
End With
'---Idxで指定したIndexのデータを取得する
RegExpFunc = vbNullString
If objMatchColl.Count > Idx Then
If Idx = -1 Then '---idxを-1でしていた時はobjMatchCollの結合モードにする
For Each objMatch In objMatchColl
RegExpFunc = RegExpFunc & strDelimiter & objMatch
Next
RegExpFunc = Replace(RegExpFunc, strDelimiter, "", 1, 1) '---先頭に余計なデリミタがあるから一度だけReplaceで削除する
Else
RegExpFunc = objMatchColl(Idx)
End If
End If
Set objMatch = Nothing
Set objReg = Nothing
End Function