Sub CATMain()
Code_von_Makro1
Code_von_Makro2
Box

End Sub

Sub Code_von_Makro1()

Dim Eingabe As String
	
'EingabeOO = "D:\pf"
'EingabeOO = InputBox ("Bitte geben Sie den Öffnungs Ort  ein.", "Alle Parts/Products Öffnen", Eingabe)

sInputFile = CATIA.FileSelectionBox("Product auswählen und ab geht’s!", "*.CATProduct", CatFileSelectionModeOpen)
'Dim oDoc As Document
'Set oDoc = CATIA.Documents.Open(sInputFile)

Pfad = Left(sInputFile, InStrRev(sInputFile, "\") )

    Dim oFileSystem As INFITF.FileSystem
    Set oFileSystem = CATIA.FileSystem
    Dim oFolder As INFITF.Folder
    ' Verzeichnisname für CATIA-Part
    Set oFolder = oFileSystem.GetFolder (Pfad)

    
    Dim FileSep As String
    FileSep = oFileSystem.FileSeparator
    Dim i As Long
    Dim j as Variant
    Dim oFile As INFITF.File
    Dim oActiveDoc As DrawingDocument
																											    'Dim BackView As DrawingView
																											    'Dim oText As DrawingText
    For i = 1 To oFolder.Files.Count
        Set oFile = oFolder.Files.Item(i)
        If Right(oFile.Name, 7) = "CATPart" Then
            Set oActiveDoc = CATIA.Documents.Open(oFolder.Path + FileSep + oFile.Name)

On Error Resume Next

		Dim document As document
		Dim splitname As string
		Set document = CATIA.ActiveDocument
		splitname = Split(document.Name, ".")
		Set pro = document.Product
		pro.PartNumber = splitname(0)

            oActiveDoc.Save
            oActiveDoc.Close
       
	End If

	'For i = 1 To oFolder.Files.Count
        	Set oFile = oFolder.Files.Item(i)
        	If Right(oFile.Name, 10) = "CATProduct" Then
            Set oActiveDoc = CATIA.Documents.Open(oFolder.Path + FileSep + oFile.Name)
		
		'Dim document As document
		'Dim splitname As string
		Set document = CATIA.ActiveDocument
		splitname = Split(document.Name, ".")
		Set pro = document.Product
		pro.PartNumber = splitname(0)

            oActiveDoc.Save
            oActiveDoc.Close
      End If

    Next

Set oDoc = CATIA.Documents.Open(sInputFile)

End Sub

Sub Code_von_Makro2() 

Set oMainProduct = CATIA.ActiveDocument.product 
Dim oMainProducts As Products
Set oMainproducts = oMainProduct.Products 
Umbenennen oMainProducts 
End Sub 
Sub Umbenennen(oProducts As Products) 
Dim oPartName As String
Dim oName As String
Dim i As Long 
For x = 1 to oProducts.Count 
Set oInstance = oProducts.Item(x)
oNumber = oInstance.PartNumber
oName = oInstance.Name 
i=0
Do 
On Error Resume Next 
i = i+1 
If i>5000 Then  ' Zahl soll angepasst werden
Exit Do
End If 
oInstance.Name = oNumber & "." & i 
If Err.Number = 0 Then 
Umbenennen oProducts.Item(x).ReferenceProduct.Products
Exit Do
ElseIf Err.Number = -2147467259 Then
Err.Clear
Err.Number = 0
Else
Exit Do
End If
Loop
If oInstance.Products.Count > 0 Then
Umbenennen oInstance.Products
End If
Next

End Sub

Sub Box()
Msgbox  "Jetzt wird der Exemplarname angepasst danach sollte das Skript fertig sein ich bitte um Feedback"
end Sub