01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89 |
|
Option Explicit
Private Declare PtrSafe Function FindWindowA Lib "user32" ( _
ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function FindWindowExA Lib "user32" ( _
ByVal hWndParent As LongPtr, ByVal hWndChildAfter As LongPtr, _
ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr
Private Declare PtrSafe Function SendMessageA Lib "user32" ( _
ByVal hWnd As LongPtr, ByVal Msg As Long, _
ByVal wParam As LongPtr, lParam As Any) As LongPtr
' Konstanten für TreeView-Operationen
Private Const TV_FIRST As Long = &H1100
Private Const TVM_GETCOUNT As Long = TV_FIRST + 5
Private Const TVM_GETNEXTITEM As Long = TV_FIRST + 10
Private Const TVM_GETITEM As Long = TV_FIRST + 12
Private Type TVITEM
mask As Long
hItem As LongPtr
STATE As Long
statemask As Long
pszText As String
cchTextMax As Long
iImage As Long
iSelectedImage As Long
cChildren As Long
lParam As LongPtr
End Type
Dim mTVI As TVITEM
Dim mhTree As LongPtr, miZeile As Long, miAnz As Long
Dim mWSh As Worksheet
Sub EnumerateTreeView()
Dim hWnd As LongPtr, hItem As LongPtr, hItem2 As LongPtr
Dim iAnz As Long, iAnzMax As Long
' Handle der App ermitteln
hWnd = FindWindowA("wndclass_desked_gsk", vbNullString) ' Handle des VBE-Editor holen
hWnd = FindWindowExA(hWnd, 0, "PROJECT", vbNullString) ' Projekt-Handle
If hWnd = 0 Then
MsgBox "Die gewünschte App wurde nicht gefunden!", vbCritical, "TreeView"
Exit Sub
End If
' TreeView vorhanden?
mhTree = FindWindowExA(hWnd, 0, "SysTreeView32", vbNullString)
If mhTree = 0 Then
MsgBox "Die App enthält kein TreeView-Element!"
Exit Sub
End If
iAnzMax = CLng(SendMessageA(mhTree, TVM_GETCOUNT, 0, ByVal 0&)) ' Anzahl der Elemente
miZeile = 1
' Root-Knoten abrufen &H0 = TVGN_ROOT
hItem = SendMessageA(mhTree, TVM_GETNEXTITEM, &H0, ByVal 0&)
If hItem = 0 Then Exit Sub
Set mWSh = Tabelle1 ' Zielblatt vorgeben
mWSh.Cells.Clear ' Altdaten löschen
SchreibeElemente hItem, 1 ' VBE-Daten schreiben
MsgBox (miZeile - 1) & " von" & Str(iAnzMax) & _
" Elementen wurden in Spalte E eingefügt!", vbInformation, "TreeView"
End Sub
Sub SchreibeElemente(ByVal hItem As LongPtr, iSp As Long)
' Schreibt den Elementtext in ein Excelblatt
Dim hChild As LongPtr
If hItem <> 0 Then
Do While hItem <> 0
With mTVI ' &H1 = TVIF_TEXT
.mask = &H1
.hItem = hItem
.pszText = String(256, vbNullChar) ' Puffer initialisieren
.cchTextMax = 256
If SendMessageA(mhTree, TVM_GETITEM, 0, mTVI) <> 0 Then _
mWSh.Cells(miZeile, iSp).Value = Left(.pszText, InStr(.pszText, vbNullChar) - 1)
End With
miZeile = miZeile + 1 ' &H4 = TVGN_CHILD
hChild = SendMessageA(mhTree, TVM_GETNEXTITEM, &H4, ByVal hItem)
If hChild <> 0 Then
SchreibeElemente hChild, iSp + 1
End If ' &H1 = TVGN_NEXT
hItem = SendMessageA(mhTree, TVM_GETNEXTITEM, &H1, ByVal hItem)
Loop
End If
End Sub
|