VBA ウィンドウの列挙 Win32 API
http://d.hatena.ne.jp/cartooh/20090618
上記のページに記載されているVBAです。
動作は確認できたのですが、どのような処理の流れとなっているのかがわかりません。
どなたかコメントを付けていただけないでしょうか。
よろしくお願いいたします。
Option Explicit
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal cnm As String, ByVal cap As String) As Long
Declare Function IsWindowVisible Lib "user32" (ByVal hWnd 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 GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Long
Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long
Const INDENT_KEY = "INDENT"
Public Function EnumChildWindowsProc(ByVal hWnd As Long, ByVal lParam As Object) As Long
EnumChildWindowsProc = EnumWindowsProc(hWnd, lParam)
End Function
Public Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Object) As Long
EnumWindowsProc = True
If IsWindowVisible(hWnd) = 0 Then
Exit Function
End If
Dim strClassName As String ' * 255
Dim strCaption As String ' * 255
strClassName = String(255, vbNullChar)
strCaption = String(255, vbNullChar)
GetWindowText hWnd, strCaption, Len(strCaption)
GetClassName hWnd, strClassName, Len(strClassName)
strCaption = RTrim(left(strCaption, InStr(1, strCaption, vbNullChar) - 1))
strClassName = RTrim(left(strClassName, InStr(1, strClassName, vbNullChar) - 1))
ActiveCell.Cells(1, 1).Value = Hex(hWnd)
ActiveCell.Cells(1, 2).Value = IsWindowVisible(hWnd)
ActiveCell.Cells(1, 3).Value = strCaption
ActiveCell.Cells(1, 4).Value = strClassName
ActiveCell.Cells(2, 2).Activate
Dim c As Collection
Set c = lParam
Dim indent As Long
indent = c(INDENT_KEY)
c.Add String(indent * 2, " ") & Hex(hWnd) & " " & strCaption & " " & strClassName, before:=c.Count
indent = indent + 1
c.Remove INDENT_KEY
c.Add indent, INDENT_KEY
Call EnumChildWindows(hWnd, AddressOf EnumChildWindowsProc, ObjPtr(c))
indent = c(INDENT_KEY) - 1
c.Remove INDENT_KEY
c.Add indent, INDENT_KEY
ActiveCell.Cells(1, 0).Activate
End Function
Sub hoge()
Application.ScreenUpdating = False
Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets(1)
sht.UsedRange.Clear
sht.Activate
sht.Range("A1").Activate
Dim c As Collection
Set c = New Collection
c.Add 0, INDENT_KEY
Dim ret As Long
ret = EnumWindows(AddressOf EnumWindowsProc, ObjPtr(c))
c.Remove INDENT_KEY
Set sht = ThisWorkbook.Worksheets(2)
sht.UsedRange.Clear
sht.Activate
sht.Range("A1").Activate
Dim o As Variant
For Each o In c
ActiveCell.Value = o
ActiveCell.Cells(2, 1).Activate
Next
Application.ScreenUpdating = True
End Sub
お礼
そうです そのサイトです。 どうやらフォルダに空白があるからエラーになっていたようです。 SoundFile = Chr(34) & Me.TextBox1.Value & Chr(34) これを追加することによって解決しました。 お騒がせしました。ありがとうございます。