WinAPIの本を読んだので、練習がてら作成してみました。
外部アプリを操作するコード(クラスモジュール)
Option Explicit
'クラス名またはキャプションからウィンドウハンドルを取得する
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
'指定ウィンドウにメッセージを送る
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As LongPtr, ByVal wParam As LongPtr, ByRef lParam As Any) As LongPtr
Private Const WM_SYSCOMMAND = &H112
Private Const SC_CLOSE = &HF060&
'指定ウィンドウをトップ位置に移動しアクティブにする
Private Declare PtrSafe Sub SetForegroundWindow Lib "user32" (ByVal hwnd As LongPtr)
'モジュール変数、定数
Private m_className As String
'指定アプリのクラス名を取得する
Public Property Let SetAppClassName(ByVal a_className As String)
m_className = a_className
End Property
'指定アプリが起動していなかったら起動する
Public Sub BootAppByWinApi()
Dim isBoot As Boolean: isBoot = CBool(FindWindow(m_className, vbNullString)) '既に起動していた場合True
If Not isBoot Then Call Shell(m_className, vbNormalFocus) '起動していなかったら、アプリを起動する
End Sub
'指定したアプリを全て閉じる
Public Sub CloseAppByWinApi()
'ウィンドウハンドルを取得
Dim hwnd As LongPtr: hwnd = FindWindow(m_className, vbNullString)
'ウィンドウハンドルを取得できた場合True
Dim isBoot As Boolean: isBoot = CBool(hwnd)
'指定アプリのウィンドウを全て閉じるまでループ
Do While isBoot
Call SendMessage(hwnd, WM_SYSCOMMAND, SC_CLOSE, 0) 'ウィンドウを閉じる
hwnd = FindWindow(m_className, vbNullString) '次のウィンドウハンドルを取得する
isBoot = CBool(hwnd) 'ウィンドウハンドルを取得できた場合True
Loop
End Sub
'指定したアプリのウィンドウを最前面に表示する
Sub MakeAppForegroundByWinApi()
Dim hwnd As LongPtr: hwnd = FindWindow(m_className, vbNullString)
Dim isBoot As Boolean: isBoot = CBool(hwnd)
'指定アプリが起動していたら、最前面に表示する
If isBoot Then Call SetForegroundWindow(hwnd)
End Sub
動作確認用コード①
起動中のIE、Chrome、フォルダを閉じる。
Sub CloseApp()
Dim myAppOperation As AppOperation: Set myAppOperation = New AppOperation
'操作するアプリのクラス名をセット
Dim nameApp() As String: nameApp() = SetClassName
'指定アプリを閉じる
Dim indexApp As Long
For indexApp = LBound(nameApp) To UBound(nameApp)
myAppOperation.SetAppClassName = nameApp(indexApp)
myAppOperation.CloseAppByWinApi
Next indexApp
'Excelを最前面に表示する
myAppOperation.SetAppClassName = "XLMAIN"
myAppOperation.MakeAppForegroundByWinApi
MsgBox ("Normal Termination")
End Sub
Function SetClassName() As String()
Dim nameApp() As String
'操作するアプリのクラス名を配列にセット
ReDim nameApp(1 To 3)
nameApp(1) = "IEFrame"
nameApp(2) = "Chrome_WidgetWin_1"
nameApp(3) = "CabinetWClass"
SetClassName = nameApp
End Function
動作確認用コード②
メモ帳を起動して閉じる
Sub OperateNotepad()
Dim notepadOperation As AppOperation: Set notepadOperation = New AppOperation
notepadOperation.SetAppClassName = "Notepad"
notepadOperation.BootAppByWinApi
notepadOperation.MakeAppForegroundByWinApi
notepadOperation.CloseAppByWinApi
End Sub