VBAから外部アプリのEdgeやChromeをSendKeysやSendMessage、keybd_eventで操作するマクロ | エクセルマクロ(VBA)実践蔵(じっせんぐら)
- エクセルマクロ(VBA)実践蔵 >
- 項目一覧 >
- VBAから外部アプリのEdgeやChromeをSendKeysやSendMessage、keybd_eventで操作するマクロ
VBAから外部アプリのEdgeやChromeをSendKeysやSendMessage、keybd_eventで操作するマクロ最終更新日：2024-08-03
- このページのもくじ
- VBAから外部アプリをSendKeysによって操作
- SendKeysによるEdge操作 - エクセルマクロ有効ブックのダウンロード
- VBAから外部アプリをウィンドウハンドル(HWND)とkeybd_eventによる制御(起動済みEdgeの画面を全選択して、Excelに貼り付ける)
VBAから外部アプリをSendKeysによって操作
既に開いているEdge又はChromeのURLを取得する。
Edgeにアクセスして、クリップボードを介してExcelに書き込むため、参照設定「Microsoft Forms 2.0 Object Library」を使用します。参照設定で見つからない場合は、参照リストの右側に参照ボタンがあるためそこから、「c:\Windows\System32\FM20.DLL」を選択することで、リストに追加され、選択できるようになります。
また、Sleep処理を行うため、標準モジュールに関数を記述するより上に「Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)」を宣言します。(64bit)
エクセルの書き込むシートは、ActiveSheetです。
Edgeなら、①AppActivate("Edge", False)とSleep 300を呼び出して、
起動済みのEdgeを再前面にしたら、Alt + D のキーを送ると、URLが選択状態になります。
Ctrl + C を送った後、もう一度、②AppActivate("Edge", False)とSleep 300を呼び出さないとうまくいきませんでした。
AppActivateの第2引数は、Trueにすると、Edgeを前面にすることはできるけれど、Excelを一度クリックしないと、マクロの続きが実行されません。なので、FalseとSleepの組み合わせを使用していて、なおかつ、サンドしないと動きませんでした。
この辺は、Windowsの仕様変更の影響を受けやすいので、いつまでもこの手段で動作させられるかはわかりません。
SendKeysに関する補足になりますが、Ctrlキーは「^」の記号で表します。また、キーボードのCキーを表すためには大文字ではなく、小文字を使用します。大文字を指定するとShiftキーも押したと解釈されます。Altキーは、「%」記号になります。
コピーが終わったら、選択状態を解除するためにEscキーを2回 実行しています。Edgeでは2回必要で、Chromeでは1回で解除されますが、Escキーを1回無駄に送っても問題なかったので、2回に合わせています。
AppActivate("Edge", False)をAppActivate("Chrome", False)に変えれば、Chromeに対して、キー操作が可能です。
下のコードでは、変数AppNameに、Edge又はChromeを指定することで切り替えられます。
コピーされたクリップボードのデータは、セルA1 Range("A1") に格納しています。
複数タブを開いている場合は、タブの移動をして、繰り返します。エクセルは、下に向かって、行を移動して記入していきます。
先頭に戻ったかを判断するために、A1セルと一致するかを確認して一致したらセルに書き込まずに終了します。
ページのソース情報が必要であれば、WebDriveを使用して開きなおす必要がありますが、表面上のテキストデータであれば、Ctrl+Aで全選択後に、Ctrl+Cでコピーができると思います。
Option Explicit
'DataObject参照設定(クリップボード)
'Microsoft Forms 2.0 Object Library
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)
Sub 外部App操作()
Dim AppName As String: AppName = "Edge"
Cells.ClearContents
'クリップボードオブジェクト
Dim cbData As New DataObject
Dim Rng As Range
Dim getTextStr As String
Set Rng = Range("A1")
Call AltDとCtrlCのキー送信でURLコピー(AppName)
Call 選択解除(AppName)
'Excel 2021 なら "Excel"を指定。365なら、"Microsoft Excel"を指定
'Call AppActivate("Microsoft Excel", False)
Call AppActivate("Excel", False)
Sleep 300
cbData.GetFromClipboard
Range("A1").Value = cbData.getText
'2つ目以降
Do
Call AltTabでTab移動してURLコピー(AppName)
'Excel 2021 なら "Excel"を指定。365なら、"Microsoft Excel"を指定
'Call AppActivate("Microsoft Excel", False)
Call AppActivate("Excel", False)
Sleep 300
cbData.GetFromClipboard
getTextStr = cbData.getText
If Range("A1").Value = getTextStr Then
'一周した
Exit Do
Else
Set Rng = Rng.Offset(1, 0)
Rng.Value = getTextStr
End If
Loop
End Sub
Function AltDとCtrlCのキー送信でURLコピー(setName As String)
Call AppActivate(setName, False)
Sleep 300
Call SendKeys("%d", True) 'Alt+Dキー
Call SendKeys("^c", True) 'Ctrl+Cキー
Call AppActivate(setName, False)
Sleep 300
End Function
Function 選択解除(setName As String)
'選択解除
Call SendKeys("{ESC}", True)
Call SendKeys("{ESC}", True)
Call AppActivate(setName, False)
Sleep 300
End Function
Function AltTabでTab移動してURLコピー(setName As String)
Call AppActivate(setName, False)
Sleep 300
'タブ移動
Call SendKeys("^{Tab}", True)
Sleep 300
Call AltDとCtrlCのキー送信でURLコピー(setName)
Call 選択解除(setName)
End Function
SendKeysによるEdge操作 - エクセルマクロ有効ブックのダウンロード
ダウンロードしたエクセルファイルを起動し、コンテンツの有効化を行う。
マクロの有効化手順については、こちら「マクロの初期設定と基本」も参考にしてください。
SendKeysによるEdgeChrome操作するエクセルマクロファイル(xlsm)のダウンロード
VBAから外部アプリをウィンドウハンドル(HWND)とkeybd_eventによる制御(起動済みEdgeの画面を全選択して、Excelに貼り付ける)
もちろん、SendKeysを使用して、Edgeの全画面を選択して、コピー後、Excelに貼り付けることは可能です。
ただ、表示しているURLのタイトル(タブに表示されている文字列)を取得するには、ウィンドウハンドルから取得する必要があります。今回は、データを貼り付けるExcelのシート名に、Edgeのタブに表示されるURLのタイトル名を設定しています。
起動済みのEdgeを再前面に移動し、Ctrl+Aで画面を全選択し、Ctrl+Cでコピー後、上矢印の押下で選択状態を解除し、Excelを再前面に移動させ、クリップボードのデータをセルA1にテキスト文章を貼り付けています。ExcelのPasteSpecialを使用しているため、前のSendKeysの時に使用していた。参照設定「Microsoft Forms 2.0 Object Library」が不要です。
上記(SendKeysのコード)と異なり、こちらは、タブ移動までは記述していません。ひとまず、ActiveSheetにEdgeに表示されている内容をコピーして貼り付けをするまでです。
デバッグする際の注意点は、keybd_eventでキーが押しっぱなしの状態でコードを終了させないでください。キーボードが正常に使用できなくなります。(再起動が必要になりました。)
keybd_eventやSendKeysを送る際、別アプリを対象としているなら、Step実行はできません。Step実行すると、VBE上でのキー挿入になってしまいます。
実行してみて、キーボードがおかしいと感じたら、キー解除(ブレイクコード)の第二引数(&H8F)を疑ってください。キーボード環境によって異なる場合があるようです。
'標準モジュールに記述
Option Explicit
'Window Handle
Declare PtrSafe Function GetForegroundWindow Lib "user32" () As Long
Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" _
(ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
Declare PtrSafe Function IsWindowVisible Lib "user32" _
(ByVal hwnd As LongPtr) As LongPtr
Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As LongPtr
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Declare PtrSafe Sub SetForegroundWindow Lib "user32" (ByVal hwnd As LongPtr)
Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As LongPtr, ByVal wMsg As LongPtr, ByVal wParam As LongPtr, lParam As LongPtr) As LongPtr
Declare PtrSafe Function GetKeyboardState Lib "user32" _
(pbKeyState As Byte) As Long
Declare PtrSafe Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)
Const GW_HWNDLAST = 1
Const GW_HWNDNEXT = 2
Const SC_MAXIMIZE As Long = &HF030&
Const WM_SYSCOMMAND As Long = &H112 '0x0112 ｼｽﾃﾑﾒﾆｭｰ(ｺﾝﾄﾛｰﾙﾒﾆｭｰ)
Sub WindowHandlingMain()
Dim hwnd As LongPtr 'ハンドリングID
Dim result As Boolean 'TimeOut確認
Dim title1 As String
Dim title2 As String
'貼り付けるExcel側の準備
ThisWorkbook.Activate
ActiveSheet.Range("A1").Select
title1 = hndling(hwnd, "Edge")
' ------------------------
' Ctrl + A で全文選択
' ------------------------
'Ctrlキーを押す(押しっぱなし)
keybd_event vbKeyControl, 0&, &H1, 0&
'Cキーを押す(押しっぱなし)
keybd_event vbKeyA, 0&, &H1, 0&
'Ctrlキーを解放（ブレイクコード）
keybd_event vbKeyControl, &H8F, &H1 Or &H2, 0
'Cキーを解放（ブレイクコード）
keybd_event vbKeyA, &H8F, &H1 Or &H2, 0
Sleep 300
' ------------------------
' Ctrl + C でコピー
' ------------------------
'Ctrlキーを押す(押しっぱなし)
keybd_event vbKeyControl, 0&, &H1, 0&
'Cキーを押す(押しっぱなし)
keybd_event vbKeyC, 0&, &H1, 0&
'Ctrlキーを解放（ブレイクコード）
keybd_event vbKeyControl, &H8F, &H1 Or &H2, 0
'Cキーを解放（ブレイクコード）
keybd_event vbKeyC, &H8F, &H1 Or &H2, 0
Sleep 300
'選択解除
'上矢印(押しっぱなし)
keybd_event vbKeyUp, 0&, &H1, 0&
'上矢印解放(ブレイクコード)
keybd_event vbKeyUp, &H8F, &H1 Or &H2, 0
Sleep 500
'Excelが最前面にくるように変更
title2 = hndling(hwnd, "Excel")
Sleep 300
Dim endp As Long
endp = InStr(1, title1, " - ", vbTextCompare)
title1 = Left(title1, endp - 1)
'クリップボードデータの取得
ActiveSheet.Name = title1
'ペーストがたまに失敗するので、Sleepを追加して回避
Sleep 500
ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
False, NoHTMLFormatting:=True
Sleep 300
End Sub
Function hndling(ByRef fhwnd As LongPtr, FindStr As String) As String
Dim captionStr As String
Dim strCaption As String * 500
fhwnd = FindWindow(vbNullString, vbNullString)
Do
GetWindowText fhwnd, strCaption, Len(strCaption)
captionStr = Left(strCaption, InStr(strCaption, vbNullChar) - 1)
If captionStr <> "" Then
Dim stp As Long
Dim getStr As String
stp = InStrRev(captionStr, " ")
getStr = Right(captionStr, Len(captionStr) - stp)
'想定通り動作しない場合のデバッグ用コード。環境下での調整が必要
'タイトル - Edge/タイトル - Chrome/ファイル名 - Excel
'と表示される環境用のコードになってます。
'Debug.Print captionStr
'引数 FindStrをタイトルに含むウィンドウを見つけたら
If InStr(1, getStr, FindStr, vbTextCompare) Then
'前面に設定する
SetForegroundWindow (fhwnd)
Sleep 500
'ウィンドウ最大化
Call SendMessage(fhwnd, WM_SYSCOMMAND, SC_MAXIMIZE, 0)
Sleep 500
Exit Do
End If
End If
strCaption = ""
fhwnd = GetNextWindow(fhwnd, GW_HWNDNEXT)
Loop Until fhwnd = GetNextWindow(fhwnd, GW_HWNDLAST)
hndling = captionStr
End Function