TreeView - Elemente des VBE auslesen
#1
Liebe Leserin, lieber Leser,

wer's brauchen kann.

Die Elemente eines TreeView lassen sich u.a. mit der Windows-API auslesen.
Das u.a. Beispiel schreibt alle momentan vorhandene Elementtexte des Visual Basic Editors (VBE) in ein Excelblatt.

Erstaunlicherweise werden auch die Elemente eines passwortgeschützten VBA-Projektes hier aufgeführt.

Viel Spaß beim Ausprobieren....

Code:

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 ErmittleTreeViewElemente()
  Dim hWnd   As LongPtr, hItem As LongPtr, hItem2 As LongPtr
  Dim iAnz As Long, iAnzMax As Long
  
  Set mWSh = Tabelle1                                       ' <<<Zielblatt vorgeben >>>
 
' 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
  
  mWSh.Cells.Clear                                  ' Altdaten löschen
  SchreibeElemente hItem, 1                         ' Daten schreiben
  
  MsgBox (miZeile - 1) & " von" & Str(iAnzMax) & _
         " Elementen wurden eingefügt!", vbInformation, "TreeView"
End Sub

Private 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

_________
viele Grüße
Karl-Heinz
[-] Folgende(r) 1 Nutzer sagt Danke an volti für diesen Beitrag:
  • schauan
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste