SeleniumのChromeDriverを自動でダウンロードする方法（VBA編）

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40

Function getChromVersion(errStr)
    On Error GoTo errH

    Dim FSO, f
    Dim regEx, matches, match
    Dim mv, latest

    ' 正規表現オブジェクトの生成とパターンのセット
    Set regEx = CreateObject("VBScript.RegExp")
    With regEx
     .Pattern = "[0-9\.]+" '数値またはピリオド
     .Global = True
    End With

    ' Chromeのメジャーバージョンを取得
    Set FSO = CreateObject("Scripting.FileSystemObject")
    latest = 0
    For Each f In FSO.GetFolder("C:\Program Files (x86)\Google\Chrome\Application").SubFolders
        If regEx.test(f.Name) Then
            mv = Left(f.Name, InStr(f.Name, ".") - 1)
            If latest < mv Then
                latest = mv
            End If
        End If
    Next

    getChromVersion = latest
finally:
    On Error Resume Next
    Set FSO = Nothing
    Set f = Nothing
    Set regEx = Nothing
    Set matches = Nothing
    Set match = Nothing
    Exit Function
errH:
    errStr = "getChromVersion error! Err.Number=[" & err.Number & "], Err.Description=[" & err.Description & "]"
    getChromVersion = -1
    Resume finally
End Function

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60

' ChromeDriverのダウンロード
Function downloadChromeDriver(latest, dest, errStr)
    On Error GoTo errH

    Dim objHtml, objDoc
    Dim aTag, skey, targetUrl

    ' XMLHTTPオブジェクトを生成
    Set objHtml = CreateObject("MSXML2.XMLHTTP")

    ' 指定URLのHTMLオブジェクトを取得
    Call objHtml.Open("GET", "https://chromedriver.chromium.org/downloads", True)
    Call objHtml.send

    ' ロード完了まで待つ
    Do While objHtml.readyState <> 4
        DoEvents
    Loop

    ' HTMLドキュメントを作成
    Set objDoc = New HTMLDocument

    ' HTMLドキュメントにHTMLテキストを書き込み
    Call objDoc.Write(objHtml.responseText)

    ' Chromeのメジャーバージョンと一致するChromeDriverのダウンロードページを取得する
    skey = "https://chromedriver.storage.googleapis.com/index.html?path="
    For Each aTag In objDoc.getElementsByTagName("a")
        targetUrl = aTag.getAttribute("href")
        If InStr(targetUrl, skey) &gt; 0 Then
            If CInt(Mid(targetUrl, Len(skey) + 1, InStr(Len(skey) + 1, targetUrl, ".") - (Len(skey) + 1))) = latest Then
                Exit For
            End If
        End If
    Next

    ' ダウンロードファイルが見つからなかった場合は処理終了
    If InStr(targetUrl, skey) = 0 And InStr(targetUrl, latest) = 0 Then GoTo notfound

    ' ダウンロードページよりWindows用のzipファイルをダウンロードする
    targetUrl = Replace(targetUrl, "index.html?path=", "") & "chromedriver_win32.zip"
    If URLDownloadToFile(0, targetUrl, dest, 0, 0) <> 0 Then
        GoTo errH
    End If

    downloadChromeDriver = 1
finally:
    On Error Resume Next
    Set objHtml = Nothing
    Set objDoc = Nothing
    Exit Function
notfound:
    errStr = "Download file is not found!"
    downloadChromeDriver = 0
    Resume finally
errH:
    errStr = "downloadChromeDriver error! Err.Number=[" & err.Number & "], Err.Description=[" & err.Description & "]"
    downloadChromeDriver = -1
    Resume finally
End Function

1
2
3
4
5
6

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

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30

'zipファイルを解凍
Public Function unZip(src, dest, errStr)
    On Error GoTo errH

    Const FOF_SILENT = &H4                '進捗ダイアログを表示しない。
    Const FOF_NOCONFIRMATION = &H10       '上書き確認ダイアログを表示しない（[すべて上書き]と同じ）。

    '指定のフォルダが存在するかチェック
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")

    If FSO.FolderExists(dest) Then
    Else
        MkDir dest
    End If
    Set FSO = Nothing

    '解凍実行
    With CreateObject("Shell.Application")
      .Namespace(dest).CopyHere .Namespace(src).Items, FOF_NOCONFIRMATION + FOF_SILENT
    End With
    unZip = 1
finally:
    On Error Resume Next
    Set FSO = Nothing
    Exit Function
errH:
    errStr = "unZip error! Err.Number=[" & err.Number & "], Err.Description=[" & err.Description & "]"
    unZip = -1
End Function

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17

' 解凍したChromeDriverを所定のフォルダに配置
Function copyChromeDriver(src, dest, errStr)
    On Error GoTo errH

    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    FSO.CopyFile src, dest, True
    copyChromeDriver = 1
finally:
    On Error Resume Next
    Set FSO = Nothing
    Exit Function
errH:
    errStr = "copyChromeDriver error! Err.Number=[" & err.Number & "], Err.Description=[" & err.Description & "]"
    copyChromeDriver = -1
    Resume finally
End Function

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44

Function autoDownloadChromedriver(errStr)
    On Error GoTo errH

    Dim latest, ret
    Dim src, dest
    Dim downloadFolder

    downloadFolder = CreateObject("Shell.Application").Namespace("shell:Downloads").self.Path

    ' Chromeのバージョンを取得
    latest = getChromVersion(errStr)
    If latest < 0 Then GoTo errH

    ' Chromeバージョンに一致するChromeDriverをダウンロード
    dest = downloadFolder & "\chromedriver_win32.zip"
    ret = downloadChromeDriver(latest, dest, errStr)
    If ret <= 0 Then GoTo errH ' 戻り値[0]: ダウンロードファイル無し、戻り値[-1]: エラー

    ' ダウンロードファイルの解凍
    src = downloadFolder & "\chromedriver_win32.zip"
    dest = downloadFolder & "\chromedriver_win32"
    ret = unZip(src, dest, errStr)
    If ret < 0 Then GoTo errH

    ' 所定の場所に格納
    src = downloadFolder & "\chromedriver_win32\chromedriver.exe"
    dest = Environ("LOCALAPPDATA") & "\SeleniumBasic\"
    ret = copyChromeDriver(src, dest, errStr)
    If ret < 0 Then GoTo errH
    autoDownloadChromedriver = 1

finally:
    On Error Resume Next
    Exit Function
errH:
    autoDownloadChromedriver = -1
    Resume finally
End Function

Sub driver()
    Dim ret, errStr
    ret = 0: errStr = ""
    ret = autoDownloadChromedriver(errStr)
End Sub