Option Explicit
Const swDocDRAWING = 3
Sub main()
    Dim swApp                   As Object
    Dim swModel                 As Object
    Dim swDraw                  As Object
    Dim swView                  As Object
    Dim swTable                 As Object
    Dim swFeat                  As Object
    Dim swBomFeat               As Object
    Dim bRet                    As Boolean
    Dim swAnn                   As Object
    Dim nNumCol                 As Long
    Dim nNumRow                 As Long
    Dim sRowStr                 As String
    Dim sTitStr                 As String
    Dim a                       As Long
    Dim j                       As Long
    Dim b                       As Long
    Dim intOutHandle            As Integer
    Dim strOneLine              As String
    Dim SWXBom()                As String
    Dim sZelle                  As String
    Dim Benennung               As Integer
    Dim Mass1Spalte             As Integer
    Dim PosSpalte               As Integer
    Dim MengenSpalte            As Integer
    Dim Zeichnungsnummer        As Integer
    Dim Hersteller              As Integer
    Dim Artikelnummer           As Integer
    Dim Dimension               As Integer
    Dim ErsatzVerschleiss       As Integer
    Dim NormTyp                 As Integer
    Dim Material                As Integer
    Dim Lieferant               As Integer
    Dim BruttoKosten            As Integer
    Dim NettoKosten             As Integer
    Dim Ersatzteilpreis         As Integer
    Dim Lieferfrist             As Integer
    'Dim Revision                As Integer'
    Dim xlApp                   As Object
   
    Set swApp = CreateObject("SldWorks.Application")
    Set swModel = swApp.ActiveDoc
   
    If swModel Is Nothing Then
        MsgBox "Keine Dokumentnte geöffnet."
        End
    End If

    If swModel.GetType <> swDocDRAWING Then
        MsgBox "Das Dokument ist keine Zeichnung."
        End
    End If
   
    Set swDraw = swModel

    Set swView = swDraw.GetFirstView
    Set swTable = swView.GetFirstTableAnnotation
   
     
    If swTable Is Nothing Then
      MsgBox "Die Zeichnung enthält keine Stückliste"
      End
    End If
   
    Do While swTable.Type <> 2
      Set swTable = swTable.GetNext
      If swTable Is Nothing Then
        MsgBox "Die Zeichnung enthält keine Stückliste"
        End
      End If
    Loop
   
    ' Debug.Print swTable.Type
   
    nNumCol = swTable.ColumnCount
    nNumRow = swTable.RowCount
         
    ' Stüli auslesen
    For j = 0 To nNumCol - 1
      sTitStr = Trim(swTable.GetColumnCustomProperty(j))
      If sTitStr = "Benennung" Then
          Benennung = j
          'Debug.Print sTitStr
      ElseIf sTitStr = "Zeichnungsnummer" Then
          Zeichnungsnummer = j
          'Debug.Print sTitStr
      ElseIf sTitStr = "Lieferant" Then
          Lieferant = j
          'Debug.Print sTitStr
      ElseIf sTitStr = "Norm / Typ" Then
          NormTyp = j
          'Debug.Print sTitStr
      ElseIf sTitStr = "Material" Then
          Material = j
          'Debug.Print sTitStr
      ElseIf sTitStr = "Hersteller" Then
          Hersteller = j
          'Debug.Print sTitStr
      ElseIf sTitStr = "Artikelnummer" Then
          Artikelnummer = j
          'Debug.Print sTitStr
      ElseIf sTitStr = "Dimension" Then
          Dimension = j
          'Debug.Print sTitStr
      ElseIf sTitStr = "Ersatzteil oder Verschleissteil" Then
          ErsatzVerschleiss = j
          'Debug.Print sTitStr
      ElseIf sTitStr = "Brutto Kosten" Then
          BruttoKosten = j
          'Debug.Print sTitStr
      ElseIf sTitStr = "Netto Kosten" Then
          NettoKosten = j
          'Debug.Print sTitStr
      ElseIf sTitStr = "Ersatzteilpreis" Then
          Ersatzteilpreis = j
          'Debug.Print sTitStr
      ElseIf sTitStr = "Lieferfrist" Then
          Lieferfrist = j
          'Debug.Print sTitStr
      'ElseIf sTitStr = "Revision" Then
          'Revision = j
          'Debug.Print sTitStr
      End If
          'Debug.Print sTitStr
      sTitStr = Trim(swTable.Text(0, j))
      If sTitStr = "Pos." Then
          PosSpalte = j
          'Debug.Print sTitStr
      ElseIf sTitStr = "Menge" Then
          MengenSpalte = j
          'Debug.Print sTitStr
      End If
      'Debug.Print sTitStr
    Next j
    ReDim SWXBom(nNumRow, 16)
    For a = 0 To nNumRow - 0
      SWXBom(a, 1) = swTable.Text(a, PosSpalte)
      'Debug.Print SWXBom(i, 1)
      SWXBom(a, 2) = swTable.Text(a, MengenSpalte)
      'Debug.Print SWXBom(i, 2)
      SWXBom(a, 3) = swTable.Text(a, Benennung)
      'Debug.Print SWXBom(i, 3)
      SWXBom(a, 4) = swTable.Text(a, Zeichnungsnummer)
      'Debug.Print SWXBom(i, 4)
      'SWXBom(a, 5) = swTable.Text(a, Revision)'
      'Debug.Print SWXBom(i, 5)
      SWXBom(a, 6) = swTable.Text(a, NormTyp)
      'Debug.Print SWXBom(i, 6)
      SWXBom(a, 7) = swTable.Text(a, Artikelnummer)
      'Debug.Print SWXBom(i, 7)
      SWXBom(a, 8) = swTable.Text(a, Dimension)
      'Debug.Print SWXBom(i, 8)
      SWXBom(a, 9) = swTable.Text(a, Material)
      'Debug.Print SWXBom(i, 9)
      SWXBom(a, 10) = swTable.Text(a, ErsatzVerschleiss)
      'Debug.Print SWXBom(i, 10)
      SWXBom(a, 11) = swTable.Text(a, Hersteller)
      'Debug.Print SWXBom(i, 11)
      SWXBom(a, 12) = swTable.Text(a, Lieferant)
      'Debug.Print SWXBom(i, 12)
      SWXBom(a, 13) = swTable.Text(a, BruttoKosten)
      'Debug.Print SWXBom(i, 13)
      SWXBom(a, 14) = swTable.Text(a, NettoKosten)
      'Debug.Print SWXBom(i, 14)
      SWXBom(a, 15) = swTable.Text(a, Ersatzteilpreis)
      'Debug.Print SWXBom(i, 15)
      

      If swTable.Text(a, Lieferfrist) <> "" Then
        SWXBom(a, 16) = swTable.Text(a, Lieferfrist)
        If Right(SWXBom(a, 16), 2) = "Lieferfrist" Then SWXBom(a, 2) = Left(SWXBom(a, 16), Len(SWXBom(a, 16)) - 2)
        'Debug.Print SWXBom(i, 16)
      End If
    Next a
    Set swApp = Nothing
    Set swModel = Nothing
    Set swDraw = Nothing
    Set swView = Nothing
    Set swTable = Nothing
    
    
    Set xlApp = CreateObject("Excel.Application")
    
    For a = 1 To nNumRow - 1
     b = a + 4 'Die Zahl entspricht der gewünschten Menge an Leerzeilen
      For j = 1 To 16
        
        Debug.Print SWXBom(a, j)
        Cells(b, j).Value = SWXBom(a, j)
      Next j
    Next a
    
    Set xlApp = Nothing
End Sub