Option Explicit
'Windows APIの宣言'
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
'#######################################################'
'フォームのボタン押下時'
Public Sub 実行_Click()
If MsgBox("実行します。", vbYesNo) = vbYes Then
'Yesの場合、バージョンのチェックと更新を実行します。'
Call chkChromeVersion
Else
MsgBox "実行を中止しました。"
End If
End Sub
'#######################################################'
'チェックと更新プログラムのMain部分'
Public Sub chkChromeVersion()
Dim BrowserVer As String
Dim thisDriverVer As String
Dim xTmpPath As String
Dim DownloadFileName As String
Dim SeleniumDriverPath As String
Dim uName As String
xTmpPath = CurrentProject.Path & "\xTmp"'Access用'
'xTmpPath = ThisWorkbook.Path & "\xTmp"'★'←Excelの場合はこちらに変更'
DownloadFileName = xTmpPath & "\chromedriver_win32.zip"
'保存先をデフォルトから変更している方は変更してください。'
uName = Environ("USERNAME")
SeleniumDriverPath = "C:\Users\" & uName & "\AppData\Local\SeleniumBasic\chromedriver.exe"
'"
'フォルダの有無の確認。なければフォルダを作成する'
If Dir(xTmpPath, vbDirectory) = "" Then
MkDir xTmpPath
End If
'PCのブラウザのバージョンをチェック'
BrowserVer = chkBrowserVer
'Seleniumで保存しているドライバのバージョンチェック'
If Dir(SeleniumDriverPath) = "" Then
'ない場合はチェックせず、新しいファイルを書き込む'
Else
thisDriverVer = chkDriverVer(SeleniumDriverPath)
End If
If BrowserVer <> thisDriverVer Then
'ブラウザバージョンと一致したドライバのダウンロード'
Call DriverDownload(BrowserVer, DownloadFileName)
'ダウンロードしたファイルを解凍して所定の場所にドライバを保存'
Call DriverUpdate(DownloadFileName, xTmpPath, SeleniumDriverPath)
Else
MsgBox "バージョン一致" '何もしない'
End If
MsgBox "完了"
End Sub
'*********************************************************'
'//【Chrome】ブラウザのバージョンチェック'
Function chkBrowserVer() As String
Dim chkVer As String
chkVer = "HKEY_CURRENT_USER\SOFTWARE\Google\Chrome\BLBeacon\version"
chkBrowserVer = CreateObject("WScript.Shell").RegRead(chkVer)
End Function
'*********************************************************'
'//現在SeleniumBasicフォルダに保存されているドライバのバージョンをチェックします'
Function chkDriverVer(SeleniumDriverPath As String) As String
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
chkDriverVer = FSO.GetFileVersion(FileName:=SeleniumDriverPath)
End Function
'*********************************************************'
'//ドライバをダウンロードします'
Public Sub DriverDownload(BrowserVer As String, dFileName As String)
Dim dURL As String
Dim dResult As String
'ダウンロードするファイルのURL'
dURL = "https://chromedriver.storage.googleapis.com/" & BrowserVer & "/chromedriver_win32.zip"
'ダウンロード'
dResult = URLDownloadToFile(0, dURL, dFileName, 0, 0)
End Sub
'*********************************************************'
'//ドライバを解凍して特定の場所に保存します。'
Public Sub DriverUpdate(DownloadFileName As String, xTmpPath As String, SeleniumDriverPath As String)
Dim psCommand As String
Dim wsh As Object
Dim dResult As String
'//実行するPowerShellのコマンド作成。「 -Force」で上書き。'
psCommand = "powershell -NoProfile -ExecutionPolicy Unrestricted Expand-Archive -Path " & DownloadFileName & " -DestinationPath " & xTmpPath & " -Force"
Set wsh = CreateObject("WScript.Shell")
'//PowerShellのコマンド実行'
'指定した場所に解凍されます。'
dResult = wsh.Run(Command:=psCommand, WindowStyle:=0, WaitOnReturn:=True)
'解凍したexeファイルをSeleniumのドライバに上書き'
FileCopy xTmpPath & "\chromedriver.exe", SeleniumDriverPath
Set wsh = Nothing
End Sub
