Google Chromeを開いて閉じる

2023年6月17日

記事の概要

ExcelvbaからGoogle Chromeを開く記事は結構あるのですが、開いて閉じるまでの流れが無かったので、何かの事情でseleniumを使えない人向けに残しておきます。
処理の流れを流用すれば、他言語でも使用できます。

ソース

Googleのトップページを開き、5秒後に閉じるサンプルです。
標準モジュールを作成し、コピペすれば使用できます。

'WinAPI宣言==================================='
'ウィンドウ列挙'
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
'キャプション取得'
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
'オーナーフォームを指定してハンドル取得'
Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
'メッセージ送信'
Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'スリープ'
Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
'定数========================================='
Public Const REG_KEY = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\chrome.exe\Path"
Public Const CY_SEARCH_NAME = "Google Chrome"
Public Const GW_OWNER = 4
Public Const WM_CLOSE = &H10
'============================================='

'コールバック'
Public Function GetProc(ByVal hwnd As Long, lParam As Long) As Boolean

    Dim MyName As String * 128
    Dim ret As Long

    MyName = ""

    'ウィンドウタイトルを取得'
    ret = GetWindowText(hwnd, MyName, Len(MyName))

    'オーナーウィンドウかの判定'
    If GetWindow(hwnd, GW_OWNER) = 0 Then

        If ret <> 0 Then

            'ウィンドウタイトルに"Google Chrome"が含まれているか'
            If InStr(MyName, CY_SEARCH_NAME) > 0 Then

                'ウィンドウを閉じる'
                Call SendMessage(hwnd, WM_CLOSE, 0, 0)

            End If

        End If

    End If

    GetProc = True

End Function

'Google Chromeを開く'
Sub OpenChrome(ByVal URL As String)

    Dim objWsh As Object
    Dim Path As String

    'WScriptオブジェクトの作成'
    Set objWsh = CreateObject("WScript.Shell")

    'Google Chromeのパスを設定'
    Path = objWsh.RegRead(REG_KEY)

    '新しいウィンドウでGoogle Chromeを開く'
    Shell "" & Path & "\chrome.exe "" --new-window " & URL, vbNormalFocus

    'WScriptオブジェクトを破棄'
    Set objWsh = Nothing

End Sub

'メイン処理'
Sub main()

    'Google Chromeの表示'
    OpenChrome "https://www.google.co.jp/"

    '5秒待機'
    Sleep 5000

    'Chromeのウィンドウを取得して閉じる'
    Call EnumWindows(AddressOf GetProc, 0)

End Sub

ソースの説明

APIの宣言と定数の宣言の説明は省きます。

メイン処理です。特筆することは特にありません。
Google Chrome表示関数をコール、その後5秒待機し、Google Chromeを閉じる関数をコールします。

'メイン処理
Sub main()

    'Google Chromeの表示
    OpenChrome "https://www.google.co.jp/"

    '5秒待機
    Sleep 5000

    'Chromeのウィンドウを取得して閉じる
    Call EnumWindows(AddressOf GetProc, 0)

End Sub

 

Google Chromeを開く関数です。
レジストリからGoogle ChromeのGoogle Chromeのexeの場所を取得しているところがミソです。

'Google Chromeを開く
Sub OpenChrome(ByVal URL As String)

    Dim objWsh As Object
    Dim Path As String

    'WScriptオブジェクトの作成
    Set objWsh = CreateObject("WScript.Shell")

    'Google Chromeのパスを設定
    Path = objWsh.RegRead(REG_KEY)

    '新しいウィンドウでGoogle Chromeを開く
    Shell "" & Path & "\chrome.exe "" --new-window " & URL, vbNormalFocus

    'WScriptオブジェクトを破棄
    Set objWsh = Nothing

End Sub

 

Google Chromeを閉じる関数です。
全ウィンドウを処理し、ウィンドウタイトルに”Google Chrome”と入っているウィンドウに対して閉じるメッセージを送ります。

'コールバック
Public Function GetProc(ByVal hwnd As Long, lParam As Long) As Boolean

    Dim MyName As String * 128
    Dim ret As Long

    MyName = ""

    'ウィンドウタイトルを取得
    ret = GetWindowText(hwnd, MyName, Len(MyName))

    'オーナーウィンドウかの判定
    If GetWindow(hwnd, GW_OWNER) = 0 Then

        If ret <> 0 Then

            'ウィンドウタイトルに"Google Chrome"が含まれているか
            If InStr(MyName, CY_SEARCH_NAME) > 0 Then

                'ウィンドウを閉じる
                Call SendMessage(hwnd, WM_CLOSE, 0, 0)

            End If

        End If

    End If

    GetProc = True

End Function

ウィンドウタイトルが長い場合は、ウィンドウを閉じることができません。
その際は「Dim MyName As String * 128」の128部分を増やすと閉じるようになります。
※ウィンドウタイトルの文字列長を取得しGetWindowTextの第3引数として渡すことでよりスマートなコードとなります。ぜひチャレンジしてみてください。

Excel VBA,ブラウザ,プログラムGoogle Chrome,vba,WinAPI

Posted by marimo