Excel

Microsoft Edgeのバージョンに合わせてWebDriverをダウンロードするVBAマクロ

ブラウザーの制御に広く使われているWebDriverですが、ブラウザーがアップデートされる度にバージョンに合わせたWebDriverの実行ファイルをダウンロード・インストールするのは手間が掛かります。

WebDriverの更新を自動で行ってくれる、「WebDriverManager」という便利なライブラリも公開されているのですが、JavaやPython、.Net向けのライブラリはあるものの、VBAマクロから使いやすそうなものは見つかりませんでした。

仕方が無いので、Microsoft Edgeのみの対応にはなりますが、インストールされているブラウザーのバージョンに合わせてWebDriverをダウンロードする、簡単なマクロを書いてみました。

Option Explicit

Public Sub Sample()
  Dim EdgeDriverFilePath As String
  Const EdgeDriverFolderPath = "C:\System\Driver\Edge" 'Edge Driverの保存場所
  
  'EdgeDriverFilePath = DownloadEdgeDriver(EdgeDriverFolderPath, "92.0.902.55") 'バージョンを指定する場合
  EdgeDriverFilePath = DownloadEdgeDriver(EdgeDriverFolderPath)
  If Len(EdgeDriverFilePath) > 0 Then
    Debug.Print "EdgeDriverFilePath:" & EdgeDriverFilePath
  End If
End Sub

Private Function DownloadEdgeDriver(ByVal EdgeDriverFolderPath As String, _
                                    Optional ByVal DriverVersion As String = "") As String
'Edge DriverをダウンロードしてDriverのパスを返す
'※バージョンを指定しない場合は現在のEdgeのバージョンに合わせてDriverをダウンロード
  Dim EdgeDriverFilePath As String
  Dim DownloadFolderPath As String
  Dim DownloadFilePath As String
  Dim SourceFilePath As String
  Dim Url As String: Url = "https://msedgedriver.azureedge.net/"
  Const DriverFileName = "msedgedriver.exe"
  Const ZipFileName = "edgedriver.zip"
  
  If Len(DriverVersion) < 1 Then DriverVersion = GetCurrentEdgeVersion
  If Isx64 Then
    Url = Url & DriverVersion & "/edgedriver_win64.zip"
  Else
    Url = Url & DriverVersion & "/edgedriver_win32.zip"
  End If
  With CreateObject("Scripting.FileSystemObject")
    EdgeDriverFolderPath = .BuildPath(EdgeDriverFolderPath, DriverVersion)
    EdgeDriverFilePath = .BuildPath(EdgeDriverFolderPath, DriverFileName)
    If .FolderExists(EdgeDriverFolderPath) Then
      'すでにEdge Driverが存在している場合は処理終了
      If .FileExists(EdgeDriverFilePath) Then
        DownloadEdgeDriver = EdgeDriverFilePath
        Exit Function
      End If
    Else
      .CreateFolder EdgeDriverFolderPath
    End If
    DownloadFolderPath = GetDownloadFolderPath(DriverVersion)
    DownloadFilePath = .BuildPath(DownloadFolderPath, ZipFileName)
    SourceFilePath = .BuildPath(DownloadFolderPath, DriverFileName)
    If DownloadFile(Url, DownloadFilePath) Then
      UnZip DownloadFilePath, DownloadFolderPath
      'Zip解凍して出力されたEdge Driverファイルを指定した場所にコピー
      If .FileExists(SourceFilePath) Then .CopyFile SourceFilePath, EdgeDriverFilePath, True
    End If
    .DeleteFolder DownloadFolderPath, True
    If .FileExists(EdgeDriverFilePath) = False Then
      .DeleteFolder EdgeDriverFolderPath, True
      EdgeDriverFilePath = ""
    End If
  End With
  DownloadEdgeDriver = EdgeDriverFilePath
End Function

Private Function Isx64() As Boolean
'64ビット環境かどうか判別
  Dim itm As Object
  Dim ret As Boolean
  
  For Each itm In CreateObject("WbemScripting.SWbemLocator") _
    .ConnectServer.ExecQuery("Select * From Win32_OperatingSystem")
    If InStr(itm.OSArchitecture, "64") Then
      ret = True
      Exit For
    End If
  Next
  Isx64 = ret
End Function

Private Function GetCurrentEdgeVersion() As String
'Edgeのバージョン取得
  Dim ret As String
  
  On Error Resume Next
  ret = CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\SOFTWARE\Microsoft\Edge\BLBeacon\version")
  On Error GoTo 0
  GetCurrentEdgeVersion = ret
End Function

Private Function GetDownloadFolderPath(ByVal DriverVersion As String) As String
'Edge Driverのダウンロード先フォルダ(Temp)のパス取得
  Dim DownloadFolderPath As String
  Const TemporaryFolder = 2
  
  With CreateObject("Scripting.FileSystemObject")
    DownloadFolderPath = .BuildPath(.GetSpecialFolder(TemporaryFolder).Path, DriverVersion)
    If .FolderExists(DownloadFolderPath) Then .DeleteFolder DownloadFolderPath, True
    .CreateFolder DownloadFolderPath
  End With
  GetDownloadFolderPath = DownloadFolderPath
End Function

Private Function DownloadFile(ByVal Url As String, ByVal OutputFilePath As String) As Boolean
'ファイルダウンロード
  Dim req As Object
  Dim ret As Boolean
  Const adTypeBinary = 1
  Const adSaveCreateOverWrite = 2
   
  Set req = CreateObject("WinHttp.WinHttpRequest.5.1")
  req.Open "GET", Url, False
  req.send
  Select Case req.Status
    Case 200
      With CreateObject("ADODB.Stream")
        .Type = adTypeBinary
        .Open
        .Write req.responseBody
        .SaveToFile OutputFilePath, adSaveCreateOverWrite
        .Close
      End With
      ret = True
    Case Else: ret = False
  End Select
  DownloadFile = ret
End Function

Private Sub UnZip(ByVal TargetFilePath As Variant, _
                  Optional ByVal OutputFolderPath As Variant = "")
'Zipファイル解凍
'※CopyHereメソッドによるZip解凍はサポート対象外( https://support.microsoft.com/ja-jp/help/2679832 )
  With CreateObject("Scripting.FileSystemObject")
    If .FileExists(TargetFilePath) = False Then Exit Sub
    If LCase(.GetExtensionName(TargetFilePath)) <> "zip" Then Exit Sub
    If .FolderExists(OutputFolderPath) = False Then
      OutputFolderPath = .GetFile(TargetFilePath).ParentFolder.Path
    End If
  End With
  With CreateObject("Shell.Application")
    .Namespace(OutputFolderPath).CopyHere .Namespace(TargetFilePath).Items, &H4 Or &H10
  End With
End Sub

処理内容は下記の通り至ってシンプルで、問題無く処理が行われれば、実行ファイルのパスが返ってきます。

  1. Edgeのバージョンを取得します。
  2. 64ビット環境かどうかを判別し、環境に合ったファイル(Zip)をダウンロードします。
  3. Zipファイルを解凍し、WebDriverの実行ファイルを指定された場所にコピーします。

コード中にも書いていますが、Zip解凍にはサポート対象外の「CopyHere」メソッドを使用しいるため、安定して処理を行いたい場合は外部のアプリケーションやライブラリを使用した方が良いでしょう。

また、以前PowerShellで似たようなコードを書いたことがあるので、こちらも参考までに載せておきます。

関連ツイート

[Power Automate Desktop]指定したフォルダ内のWordファイルをPDFに一括変換するフロー前のページ

[Power Automate Desktop]Acrobatを操作して指定したPDFにテキストフィールドを被せてマスキングするフロー次のページ

関連記事

  1. Office関連

    VBAからRegistration-Freeで.NETベースのDLLを呼び出す方法

    C#製のDLLをVBAから呼び出すのにいちいちRegAsmするのも面倒…

  2. Office関連

    PDFを他のファイル形式に変換するVBAマクロ

    「PDF 変換 Word VBA」といったキーワード検索でのアクセスが…

  3. Office アドイン

    [Officeアドイン]枠線(目盛線)の表示・非表示を切り替える方法

    ここ二週間ほど体調を崩していたので久しぶりのブログ更新です。久…

  4. Office関連

    ZIP形式で圧縮・解凍を行うVBAマクロ

    この記事のように、処理の中でZIP形式のファイルを扱うことはありました…

  5. Office関連

    Excel REST APIをPowerShellから呼び出す方法

    以前Excel REST APIをVBAから呼び出す方法を紹介しました…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

Translate

Chinese (Simplified)Chinese (Traditional)EnglishFrenchGermanJapaneseKoreanRussianSpanish

最近の記事

アーカイブ

PAGE TOP