[VBA]バッチコマンドを通してブラウザを起動する

1. 簡易起動

Browser起動モジュール

Option Explicit

' 参照設定
' Windows Script Host Object Model
'  
Public Sub LaunchBrowser(url)
    Const BROWSER_EXE_PATH As String = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
    
    ' クォーテーション
    Dim QUOT As String
    QUOT = Chr(34)

    ' コマンドを組み立てる
    Dim command As String
    command = QUOT _
               & QUOT & BROWSER_EXE_PATH & QUOT _
               & " " _
               & QUOT & url & QUOT _
               & QUOT
     
    Dim wsh As New IWshRuntimeLibrary.WshShell
    Dim result As WshExec
    Set result = wsh.Exec("%ComSpec% /c " & command)
    Set wsh = Nothing
End Sub

呼び出しモジュール

Public Sub Test()
    Dim url As String
    url = "https://www.yahoo.co.jp/"
    Call LaunchBrowser(url)
End Sub

 

2. 起動ブラウザの選択

Browser起動モジュール

Option Explicit
Public Sub LaunchBrowser(url, browserType As eBrowserType)

    ' ブラウザのexeのパス
    Const CHROME_EXE_PATH As String = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
    Const EDGE_EXE_PATH As String = "C:\Program Files (x86)\Microsoft\Edge\Application\msedge.exe"
    
    Dim browserExePath As String
    If (browserType = eBrowserType.Chrome) Then
        browserExePath = CHROME_EXE_PATH
    Else
        browserExePath = EDGE_EXE_PATH
    End If
    
    ' クォーテーション
    Dim QUOT As String
    QUOT = Chr(34)

    ' コマンドを組み立てる
    Dim command As String
    command = QUOT _
               & QUOT & browserExePath & QUOT _
               & " " _
               & QUOT & url & QUOT _
               & QUOT
     
    Dim wsh As New IWshRuntimeLibrary.WshShell
    Dim result As WshExec
    Set result = wsh.Exec("%ComSpec% /c " & command)
    Set wsh = Nothing
End Sub

呼び出しモジュール

Public Sub Test()
    Dim url As String
    url = "https://www.yahoo.co.jp/"
  ' Edgeで起動する
    Call LaunchBrowser(url, eBrowserType.Edge)

  ' Chromeで起動する
    Call LaunchBrowser(url, eBrowserType.Chrome)
End Sub

 

3. パラメータ付き(本格実装)

Browserクラス

Option Explicit

' 参照設定
' Windows Script Host Object Model
'  : バッチクラス
' Microsoft Scripting Runtime
'  : Dictionary

Private mUrl As String
Private mParams As Dictionary

' コンストラクタ
Private Sub Class_Initialize()
    Set mParams = New Dictionary
End Sub

' デストラクタ
Private Sub Class_Terminate()
    Set mParams = Nothing
End Sub

' Setter: url
Public Sub SetUrl(url As String)
    mUrl = url
End Sub

' Setter: Params
Public Sub AddParam(k As String, v As String)
    Call mParams.Add(k, v)
End Sub

' ブラウザを起動する。
Public Function Launch(Optional timeout As Long = 10000) As browserResponse

    ' コマンド実行
    Call ExecuteCommand
    
    ' レスポンス取得
    Dim response As New browserResponse
    Call response.Receive(timeout)
    Set Launch = response
End Function

' コマンドを生成する
Private Function CreateCommand() As String
    Const BROWSER_EXE_PATH As String = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
    
    ' クォーテーション
    Dim QUOT As String
    QUOT = Chr(34)
    
    ' クエリ結合
    Dim joined_param As String
    joined_param = JoinParam(mParams)
                
    ' URL結合
    ' command : ""(略)chrome.exe" "https://...?p=v""
    Dim command As String
    command = QUOT _
               & QUOT & BROWSER_EXE_PATH & QUOT _
               & " " _
               & QUOT & mUrl & joined_param & QUOT _
               & QUOT
    CreateCommand = command
End Function

' コマンドを実行する
Private Function ExecuteCommand()
    ' コマンド生成
    Dim command As String
    command = CreateCommand
    
    ' 実行
    Dim wsh As New IWshRuntimeLibrary.WshShell
    Dim result As WshExec
    Set result = wsh.Exec("%ComSpec% /c " & command)
    Set wsh = Nothing
End Function

' url形式に結合したパラメータを返却する
Private Function JoinParam(params As Dictionary) As String
    If (params.Count = 0) Then
        JoinParam = ""
        Exit Function
    End If
    
    ' パラメータ結合
    Dim p As String
    p = "?"
    Dim key As Variant
    For Each key In params
        p = p & key & "=" & params.Item(key)
        p = p & "&"
    Next
    ' 末尾の不要な&を削除
    p = Left(p, Len(p) - 1)
    JoinParam = p
End Function

 

呼び出しモジュール

   Dim url As String
    url = "https://~~~~"
    Dim browser As New browser
    With browser
        Call .SetUrl(url)
        Call .AddParam("param1", "value1")
        Call .AddParam("param2", "value2")
        Call .Launch
    End With