Public Sub tvBem_Laden()
' TreeView laden
Dim objBem As Object
Dim Nod As Object
Dim rst As DAO.Recordset
 
   On Error GoTo tvBem_Laden_Error
 
   LockWindowUpdate (tvBem.hwnd)
 
   ' Verweis auf Treeview setzen
   Set objBem = Me!tvBem.Object
   'Treeview leeren
   objBem.Nodes.Clear
 
   ' Alle Plattformen
   sSql = "SELECT * FROM tblPlattform"
   Set rst = DB.OpenRecordset(sSql, dbOpenSnapshot)
   ' TreeView sortiert füllen
   Do While Not rst.EOF
      ' Key besteht aus "P" und PlattformText
      Set Nod = objBem.Nodes.Add(Key:="P" & CStr(rst!PlID), _
                                 Text:="Typ " & rst!PlText, _
                                 Image:=6)
      Nod.ExpandedImage = 1
      Nod.Expanded = True
      rst.MoveNext
   Loop
   rst.Close
 
   ' Alle Produktgruppen eintragen
   sSql = "SELECT DISTINCT  tblArtikel.Pl_ID, tblArtikel.Pr_ID," & _
     "tblProduktgruppe.PrText " & _
          "FROM tblProduktgruppe RIGHT JOIN (tblPlattform RIGHT JOIN tblArtikel" & _
          "ON tblPlattform.PlID = tblArtikel.Pl_ID) " & _
          "ON tblProduktgruppe.PrID = tblArtikel.Pr_ID"
 
   Set rst = DB.OpenRecordset(sSql, dbOpenSnapshot)
 
   Do While Not rst.EOF
      Set Nod = objBem.Nodes.Add(relative:="P" & CStr(rst!Pl_ID), _
                                 Relationship:=4, _
                                 Key:="G" & CStr(rst!Pr_ID) & "P" & CStr( _
                                 rst!Pl_ID), _
                                 Text:="Zsb.: " & rst!PrText, _
                                 Image:=21)
      rst.MoveNext
   Loop
   rst.Close
 
   ' Alle Artikel eintragen
   sSql = "SELECT ArtID, Pr_ID, Pl_ID, ArtSachnummer FROM tblArtikel"
 
   Set rst = DB.OpenRecordset(sSql, dbOpenSnapshot)
 
   Do While Not rst.EOF
      Set Nod = objBem.Nodes.Add(relative:="G" & CStr(rst!Pr_ID) & "P" & CStr( _
        rst!Pl_ID), _
                                 Relationship:=4, _
                                 Key:="B" & CStr(rst!ArtID), _
                                 Text:=rst!ArtSachnummer, _
                                 Image:=15)
      rst.MoveNext
   Loop
   rst.Close
 
 
   On Error GoTo 0
   LockWindowUpdate (0)
   Exit Sub
 
 
 
 
tvBem_Laden_Error:
   LockWindowUpdate (0)
   MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure" & _
     "tvBem_Laden of VBA Dokument Form_frmBem"
 
End Sub