Attribute VB_Name = "MOD_Main"
Public CATIA
Public aDocs()
Public mDocs As Collection

Sub Main()

   FUNC_CatiaOpen
   Set oRoot = CATIA.ActiveDocument

'   '--- dynamisches Array
   sStartTime = Timer
   ReDim aDocs(3, 0)
   AddDocArray oRoot
   SUB_ScanTreeDynA oRoot.Product.Products
   MsgBox (Timer - sStartTime) & " Sekunden bei " & UBound(aDocs, 2) & " Dokumenten", 64, " Auslesen mittels dynamischem Array dauert  "

   '--- "mehrdimensionale" Collection
   Set mDocs = New Collection
   sStartTime = Timer
   AddDocCol oRoot
   SUB_ScanTreeColl oRoot.Product.Products
   MsgBox (Timer - sStartTime) & " Sekunden bei " & mDocs.Count & " Dokumenten", 64, " Auslesen mittels Collection dauert  "

End Sub

Function FUNC_CatiaOpen()
   Err.Number = 0
   On Error Resume Next
   Set CATIA = GetObject(, "Catia.Application")
   If Err.Number <> 0 Then
      MsgBox "Kein CATIA geöffnet.    " & vbLf & "Abbruch.", 16, "Error"
      End
   End If
   On Error GoTo 0
End Function

Sub SUB_ScanTreeDynA(oProducts)
   For i = 1 To oProducts.Count
      Set oItem = oProducts.Item(i)
      Set oDoc = func_GetDoc(oItem)
      If Not func_bDocEx(oDoc) Then
         AddDocArray oDoc
      End If
      SUB_ScanTreeDynA oItem.Products
   Next
End Sub

Sub SUB_ScanTreeColl(oProducts)
   For i = 1 To oProducts.Count
      Set oItem = oProducts.Item(i)
      Set oDoc = func_GetDoc(oItem)
      If Not func_IsInCol(oDoc.FullName) Then
         AddDocCol oDoc
      End If
      SUB_ScanTreeColl oItem.Products
   Next
End Sub

Function func_GetDoc(oItem) As Variant
   If oItem.HasAMasterShapeRepresentation Then
      Set func_GetDoc = oItem.GetMasterShapeRepresentation(False)
   Else
      Set func_GetDoc = oItem.ReferenceProduct.Parent
   End If
End Function

Function func_bDocEx(oDoc) As Boolean
   For i = 1 To UBound(aDocs, 2)
      If oDoc.FullName = aDocs(0, i).FullName Then
         func_bDocEx = True
         Exit For
      End If
   Next
End Function

Function func_IsInCol(ByRef sKey As String) As Boolean
   On Error Resume Next
   If IsEmpty(mDocs(sKey)) Then
      func_IsInCol = False
   Else
      func_IsInCol = True
   End If
   On Error GoTo 0
End Function

Sub AddDocArray(oDoc)
   ReDim Preserve aDocs(3, UBound(aDocs, 2) + 1)
   Set aDocs(0, UBound(aDocs, 2)) = oDoc
   aDocs(1, UBound(aDocs, 2)) = oDoc.Path
   aDocs(2, UBound(aDocs, 2)) = oDoc.Name
   aDocs(3, UBound(aDocs, 2)) = oDoc.Saved
End Sub

Sub AddDocCol(oDoc)
   Dim aItem(3)
   Set aItem(0) = oDoc
   aItem(1) = oDoc.Path
   aItem(2) = oDoc.Name
   aItem(3) = oDoc.Saved
   mDocs.Add aItem, oDoc.FullName
End Sub