Von Autodesk Inventor 2016 per VBA-Makro (for Applications) Parameter in Excel übertragen (Windows 10 64-bit)

Sub ParamExport()

    Dim iRow As Long
    Dim i As Long
    Dim XL As Excel.Application
    Dim xlWB As Object
    Dim xlWS As Object
    
  
     Set XL = CreateObject("Excel.Application")  
' Dateipfad und Name  
    Set xlWB = XL.Workbooks.Open("C:\Users\XYZ\Desktop\xml-Check.xlsm")  
    Set xlWS = xlWB.ActiveSheet
  
    XL.Application.Visible = True
  
    Dim oParams As Parameters
    Dim sDocName As String
    
' Blattname  
    xlWB.Sheets("Tabelle1").Select  
    Set xlWS = xlWB.ActiveSheet
    Const Pi As Double = 3.14159265358979

    If ThisApplication.ActiveDocumentType <> kAssemblyDocumentObject And _
        ThisApplication.ActiveDocumentType <> kPartDocumentObject Then
        MsgBox "Only Part or Assymbly document", vbCritical  
        Exit Sub
    End If
On Error Resume Next
    Set oParams = ThisApplication.ActiveDocument.ComponentDefinition.Parameters
    
    iRow = 2
    xlWS.cells(iRow, 1).Value = "Type"  
    xlWS.cells(iRow, 2).Value = "Name"  
    xlWS.cells(iRow, 3).Value = "Unit"  
    xlWS.cells(iRow, 4).Value = "Equation"  
    xlWS.cells(iRow, 5).Value = "Nennwert"  
    xlWS.cells(iRow, 6).Value = "Export"  
    xlWS.cells(iRow, 7).Value = "Health"  

    For i = 1 To oParams.Count
        iRow = iRow + 1
        Select Case oParams.Item(i).Type
            Case kModelParameterObject
                xlWS.cells(iRow, 1).Value = "Model"  
            Case kUserParameterObject
                xlWS.cells(iRow, 1).Value = "User"  
            Case kTableParameterObject
                xlWS.cells(iRow, 1).Value = "Table"  
        End Select
        xlWS.cells(iRow, 2).Value = oParams.Item(i).Name
        xlWS.cells(iRow, 3).Value = oParams.Item(i).Units
        xlWS.cells(iRow, 4).Value = oParams.Item(i).Expression
      
        Select Case oParams.Item(i).Units
            Case "mm"  
                xlWS.cells(iRow, 5).Value = FormatNumber(oParams.Item(i).Value * 10) '* 10, 4) & " mm"  
            Case "grd"  
                xlWS.cells(iRow, 5).Value = FormatNumber(oParams.Item(i).Value * (180 / Pi), 4) '& " °"  
            Case "oE"  
                xlWS.cells(iRow, 5).Value = FormatNumber(oParams.Item(i).Value, 1) '& " oE"  
            Case Else
                xlWS.cells(iRow, 5).Value = oParams.Item(i).Value
        End Select
                          
        xlWS.cells(iRow, 6).Value = oParams.Item(i).ExposedAsProperty
        Select Case oParams.Item(i).HealthStatus
            Case kDeletedHealth
                xlWS.cells(iRow, 7).Value = "Deleted"  
            Case kDriverLostHealth
                xlWS.cells(iRow, 7).Value = "Driver Lost"  
            Case kInErrorHealth
                xlWS.cells(iRow, 7).Value = "In Error"  
            Case kOutOfDateHealth
                xlWS.cells(iRow, 7).Value = "Out of Date"  
            Case kUnknownHealth
                xlWS.cells(iRow, 7).Value = "Unknown"  
            Case kUpToDateHealth
                xlWS.cells(iRow, 7).Value = "Up to Date"  
        End Select
    Next
  
    XL.cells.Select
    XL.cells.EntireColumn.AutoFit
    xlWS.Range("A1").Select  
Set xlWS = Nothing
Set xlWB = Nothing
Set XL = Nothing
End Sub