Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
ByVal hWndParent As Long, _
ByVal hWndChildAfter As Long, _
ByVal lpszClass As String, _
ByVal lpszWindow As String) As Long
Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any) As Long
Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
ByRef Destination As Any, _
ByRef Source As Any, _
ByVal Length As Long)
Declare PtrSafe Function GetClassNameA Lib "user32" ( _
ByVal hWnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Const TV_FIRST As Long = &H1100
Const TVM_GETNEXTITEM As Long = TV_FIRST + 10
Const TVM_GETITEM As Long = TV_FIRST + 12
Const TVGN_ROOT As Long = &H0
Const TVGN_NEXT As Long = &H1
Const TVIF_TEXT As Long = &H1
Type tvItem
mask As Long
hItem As Long
state As Long
stateMask As Long
pszText As LongPtr
cchTextMax As Long
iImage As Long
iSelectedImage As Long
cChildren As Long
lParam As Long
End Type
Sub EnumerateTreeView()
Dim hWndParent As Long
Dim hWndTree As Long
Dim hItem As Long
Dim tvItem As tvItem
Dim buffer As String
Dim result As Long
Dim row As Integer
hWndParent = FindWindowHandleByTitle("DIFF")
If hWndParent = 0 Then
MsgBox "Fenster mit Titel 'Diff' nicht gefunden!"
Exit Sub
End If
hWndTree = FindChildWindowHandleByClassName(hWndParent, "SysTreeView32")
If hWndTree = 0 Then
MsgBox "TreeView-Steuerelement nicht gefunden!"
Exit Sub
End If
hItem = SendMessage(hWndTree, TVM_GETNEXTITEM, TVGN_ROOT, ByVal 0&)
If hItem = 0 Then
MsgBox "Kein Root-Knoten gefunden."
Exit Sub
End If
row = 1
Do While hItem <> 0
buffer = String(256, vbNullChar)
With tvItem
.mask = TVIF_TEXT
.hItem = hItem
.pszText = StrPtr(buffer)
.cchTextMax = Len(buffer)
End With
result = SendMessage(hWndTree, TVM_GETITEM, 0, tvItem)
If result <> 0 Then
Cells(row, 5).Value = Left(buffer, InStr(buffer, vbNullChar) - 1)
row = row + 1
Else
Debug.Print "Fehler beim Abrufen des Knotens: " & hItem
End If
hItem = SendMessage(hWndTree, TVM_GETNEXTITEM, TVGN_NEXT, hItem)
Loop
MsgBox "Fertig! Knoten wurden ab Spalte E eingefügt."
End Sub
Function FindWindowHandleByTitle(windowTitle As String) As Long
FindWindowHandleByTitle = FindWindow(vbNullString, windowTitle)
End Function
Function FindChildWindowHandleByClassName(hWndParent As Long, className As String) As Long
Dim hWndChild As Long
hWndChild = FindWindowEx(hWndParent, 0, vbNullString, vbNullString)
Do While hWndChild <> 0
If GetWindowClassName(hWndChild) = className Then
FindChildWindowHandleByClassName = hWndChild
Exit Function
End If
FindChildWindowHandleByClassName = FindChildWindowHandleByClassName(hWndChild, className)
If FindChildWindowHandleByClassName <> 0 Then Exit Function
hWndChild = FindWindowEx(hWndParent, hWndChild, vbNullString, vbNullString)
Loop
FindChildWindowHandleByClassName = 0
End Function
Function GetWindowClassName(hWnd As Long) As String
Dim classNameBuffer As String
classNameBuffer = String(256, vbNullChar)
Dim result As Long
result = GetClassNameA(hWnd, classNameBuffer, Len(classNameBuffer))
If result <> 0 Then
GetWindowClassName = Left(classNameBuffer, result)
Debug.Print GetWindowClassName
Else
GetWindowClassName = vbNullString
End If
End Function