Danke Volti
Doch weiterhin bleibt das Problem bestehen, dass das Programm abstürzt:
' API-Deklarationen
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
ByVal hWndParent As LongPtr, _
ByVal hWndChildAfter As LongPtr, _
ByVal lpszClass As String, _
ByVal lpszWindow As String) As LongPtr
Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hWnd As LongPtr, _
ByVal Msg As Long, _
ByVal wParam As LongPtr, _
ByRef lParam As Any) As LongPtr
Declare PtrSafe Function GetClassNameA Lib "user32" ( _
ByVal hWnd As LongPtr, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
ByRef Destination As Any, _
ByRef Source As Any, _
ByVal Length As Long)
' Konstanten für TreeView-Operationen
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
' TreeView-Item Struktur
Type TVITEM
mask As Long
hItem As LongPtr
state As Long
stateMask As Long
pszText As LongPtr
cchTextMax As Long
iImage As Long
iSelectedImage As Long
cChildren As Long
lParam As LongPtr
End Type
Sub EnumerateTreeView()
Dim hWndParent As LongPtr
Dim hWndTree As LongPtr
Dim hItem As LongPtr
Dim tvItem As TVITEM
Dim buffer As String
Dim result As LongPtr
Dim row As Integer
' Fenster "Diff" suchen
hWndParent = FindWindowHandleByTitle("Diff")
If hWndParent = 0 Then
MsgBox "Fenster mit Titel 'Diff' nicht gefunden!"
Exit Sub
End If
' Suche nach dem TreeView-Steuerelement im Fenster
hWndTree = FindChildWindowHandleByClassName(hWndParent, "SysTreeView32")
If hWndTree = 0 Then
MsgBox "TreeView-Steuerelement nicht gefunden!"
Exit Sub
End If
' Root-Knoten abrufen
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) ' Puffer initialisieren
' TVITEM initialisieren
With tvItem
.mask = TVIF_TEXT
.hItem = hItem
.pszText = StrPtr(buffer)
.cchTextMax = Len(buffer)
End With
' Knoteninformationen abrufen
result = SendMessage(hWndTree, TVM_GETITEM, 0, tvItem) ' Hier stürzt das externe Programm ab.
If result <> 0 Then
' Knoteninformationen in die Tabelle schreiben
Cells(row, 5).Value = Left(buffer, InStr(buffer, vbNullChar) - 1)
row = row + 1
Else
Debug.Print "Fehler beim Abrufen des Knotens: " & hItem
End If
' Nächsten Knoten abrufen
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 LongPtr
' Sucht nach einem Fenster mit einem bestimmten Titel und gibt das Handle zurück
FindWindowHandleByTitle = FindWindow(vbNullString, windowTitle)
End Function
Function FindChildWindowHandleByClassName(hWndParent As LongPtr, className As String) As LongPtr
Dim hWndChild As LongPtr
hWndChild = FindWindowEx(hWndParent, 0, vbNullString, vbNullString)
Do While hWndChild <> 0
' Prüfen, ob das aktuelle Fenster die gewünschte Klasse hat
If GetWindowClassName(hWndChild) = className Then
FindChildWindowHandleByClassName = hWndChild
Exit Function
End If
' Rekursiv nach weiteren Kindern suchen
FindChildWindowHandleByClassName = FindChildWindowHandleByClassName(hWndChild, className)
If FindChildWindowHandleByClassName <> 0 Then Exit Function
' Nächstes Kind suchen
hWndChild = FindWindowEx(hWndParent, hWndChild, vbNullString, vbNullString)
Loop
' Kein passendes Fenster gefunden
FindChildWindowHandleByClassName = 0
End Function
Function GetWindowClassName(hWnd As LongPtr) 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)
Else
GetWindowClassName = vbNullString
End If
End Function
|