もくじ
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