vbaの開いているウィンドウをすべて確認してください

Question

基本的には、vbaを使用してデスクトップ上の開いているウィンドウをすべてチェックするコードが必要です。

これには、アプリケーションのウィンドウも含まれます。

また、Windowsの名前を知る必要があります。

一般に、Winrarのデスクトップウィンドウが「Updating archive x」という名前のアーカイブにファイルを追加するときなど、アプリケーションWinrarが特定の操作を進めているかどうかを知りたい場合、このテキストを私のVBAコード。

私はもっと多くのアプリケーションでも同じことが必要なので、そのための関数を得るのはいいと思います。

ありがとうございます。

Answer 1

2つの関数の宣言がすべて見つかりました。これは、書き込み先のテキストエディットコントロールを見つけることを期待この

Order Level WindowText ClassName HWnd ParentHWnd ProcessID ParentProcessID ThreadID ModuleNameHWin EXENameProcess 
1 0 MSCTFIME UI MSCTFIME UI 16253876 16253876 3288 6640 7404 C:\Users\David Candy\Desktop\Editor\EditorSdi\Ed.exe explorer.exe 
2 0 Default IME IME 9503286 16253876 3288 6640 7404 «Not Available Error=126» explorer.exe 

のような出力を与えます。

Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long 
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long 
Public Declare Function GetMapMode Lib "gdi32" (ByVal hdc As Long) As Long 
Public Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long 
Public Declare Function GetStringTypeEx Lib "kernel32" Alias "GetStringTypeExA" (ByVal Locale As Long, ByVal dwInfoType As Long, ByVal lpSrcStr As String, ByVal cchSrc As Long, ByRef lpCharType As Integer) As Long 
Public Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long 
Public Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long 
Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long 
Public Declare Function GetTopWindow Lib "user32" (ByVal hwnd As Long) As Long 
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long 
Public Declare Function GetWindowModuleFileName Lib "user32" Alias "GetWindowModuleFileNameA" (ByVal hwnd As Long, ByVal WinModule As String, StringLength As Long) As Long 
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long 
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long 
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long 

     Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long 
     Private Declare Function CloseHandle Lib "Kernel32.dll" (ByVal Handle As Long) As Long 
     Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long 
    Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long 

    Private Declare Function GetVersionExA Lib "kernel32" _ 
     (lpVersionInformation As OSVERSIONINFO) As Integer 
     Private Type PROCESSENTRY32 
     dwSize As Long 
     cntUsage As Long 
     th32ProcessID As Long   ' This process 
     th32DefaultHeapID As Long 
     th32ModuleID As Long   ' Associated exe 
     cntThreads As Long 
     th32ParentProcessID As Long  ' This process's parent process 
     pcPriClassBase As Long   ' Base priority of process threads 
     dwFlags As Long 
     szExeFile As String * 260 ' MAX_PATH 
     End Type 

     Private Type OSVERSIONINFO 
     dwOSVersionInfoSize As Long 
     dwMajorVersion As Long 
     dwMinorVersion As Long 
     dwBuildNumber As Long 
     dwPlatformId As Long   '1 = Windows 95 2 = Windows NT 
     szCSDVersion As String * 128 
     End Type 

     Private Const PROCESS_QUERY_INFORMATION = 1024 
     Private Const PROCESS_VM_READ = 16 
     Private Const MAX_PATH = 260 
     Private Const STANDARD_RIGHTS_REQUIRED = &HF0000 
     Private Const SYNCHRONIZE = &H100000 
     'STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF 
     Private Const PROCESS_ALL_ACCESS = &H1F0FFF 
     Private Const TH32CS_SNAPPROCESS = &H2& 
     Private Const hNull = 0 
     Private Const GW_CHILD = 5 
     Private Const GW_HWNDNEXT = 2 

Private Type GUID 
    Data1 As Long 
    Data2 As Integer 
    Data3 As Integer 
    Data4(7) As Byte 
End Type 
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long 
Private Declare Function IsWindowUnicode Lib "user32" (ByVal hwnd As Long) As Boolean 
Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any) 
Private Declare Function CoCreateGuid Lib "OLE32.DLL" (pGuid As GUID) As Long 

Sub mnuInsertWindowList_Click() 
' WindowChain = 0 
    Dim hwnd As Long 
     hwnd = GetTopWindow(0) 
     If hwnd <> 0 Then 
      AddChildWindows hwnd, 0 
     End If 
End Sub 


Private Function AddChildWindows(ByVal hwndParent As Long, ByVal Level As Long) As String 
     Dim gwfnhwnd As Long, X As Long, WT As String, CN As String, Length As Long, hwnd As Long, TID As Long, PID As Long, MN As String, Ret As Long, Parenthwnd As Long 
     Static Order As Long 
     Static FirstTime As Long 
     Parenthwnd = hwndParent 
     If Level = 0 Then 
         hwnd = hwndParent 
     Else 
      hwnd = GetWindow(hwndParent, GW_CHILD) 
     End If 
     Do While hwnd <> 0 
       WT = Space(512) 
        Length = GetWindowText(hwnd, WT, 508) 
        WT = Left$(WT, Length) 
        If WT = "" Then WT = Chr(171) & "No Window Text " & Err.LastDllError & Chr(187) 
        CN = Space(512) 
        Length = GetClassName(hwnd, CN, 508) 
        CN = Left$(CN, Length) 
        If CN = "" Then CN = "Error=" & Err.LastDllError 


        TID = GetWindowThreadProcessId(hwnd, PID) 

        MN = Space(512) 
        Length = GetWindowModuleFileName(hwnd, MN, 508) 
        If Length = 0 Then 
        MN = Chr(171) & "Not Available Error=" & Err.LastDllError & Chr(187) 
        Else 
        MN = Left$(MN, Length) 
        End If 


       Dim f As Long, sname As String, PList As String, PPID As Long 
       Dim hSnap As Long, proc As PROCESSENTRY32, Temp As String 
       hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0) 
       If hSnap = hNull Then Exit Function 
       proc.dwSize = LenB(proc) 
       ' Iterate through the processes 
       f = Process32First(hSnap, proc) 
       Do 
         If PID = proc.th32ProcessID Then 
          sname = StrZToStr(proc.szExeFile) 
          PPID = proc.th32ParentProcessID 
         End If 
         f = Process32Next(hSnap, proc) 
       Loop While f = 1 
        Order = Order + 1 
'     CStr(Order) & " HWnd=" & FormatNumber$(hwnd, 0, vbFalse, vbFalse, vbFalse) & " Parent HWnd=" & FormatNumber$(Parenthwnd, 0, vbFalse, vbFalse, vbFalse) & " Level=" & CStr(Level) & WT & " (" & CN & ")" & " PID=" & FormatNumber$(PID, 0, vbFalse, vbFalse, vbFalse) & " TID=" & FormatNumber$(TID, 0, vbFalse, vbFalse, vbFalse) & " Module Name:" & MN & " ExeName:" & sname & vbCrLf 
       If FirstTime = 0 Then 
        txtNote.SelText = vbCrLf & "Order" & vbTab & "Level" & vbTab & "WindowText" & vbTab & "ClassName" & vbTab & "HWnd" & vbTab & "ParentHWnd" & vbTab & "ProcessID" & vbTab & "ParentProcessID" & vbTab & "ThreadID" & vbTab & "ModuleNameHWin" & vbTab & "EXENameProcess" 
        FirstTime = 1 
       End If 
       txtNote.SelText = vbCrLf & CStr(Order) & vbTab & CStr(Level) & vbTab & WT & vbTab & CN & vbTab & CStr(hwnd) & vbTab & CStr(Parenthwnd) & vbTab & CStr(PID) & vbTab & CStr(PPID) & vbTab & CStr(TID) & vbTab & MN & vbTab & sname 

        AddChildWindows hwnd, Level + 1 
        hwnd = GetWindow(hwnd, GW_HWNDNEXT) 
     Loop 
     End Function