VBA: Replace components in different assemblies

[mario170979]

Hello i have to clean some assembly. For this i must replace in 20-30 assemblies from time to time parts. I would like to handle this with vba but dont have a idea how to make this in more than the actual opened assembly. is there a way to do this half automaticly with a list of parts (original -> new) and than inventor loop through all assembly in a folder and replace this parts?

[Frederick_Law]

1) Put all 20-30 assemblies in an assembly then loop inside that assembly.

Or just replace component, don't need code.

2) Put those 20-30 assemblies in a folder then loop inside that folder.

[BrianEkins · Accepted solution]

I think this will do what you need.  It's a VBA macro.

Public Sub ReplaceParts()
    ' This is used to define the list of old and new file.  The first number in
    ' Dim statement is the number of files in the list.  The number is one less
    ' than the total number since the list starts at zero.  The second number
    ' is always 1.
    '
    ' You can see where the old file and the new file are listed where each pair
    ' of files has it's own unique first index. For the second index, the old
    ' filename is 0 and the new filename is 1.
    Dim files(3, 1) As String
    files(0, 0) = "C:\Users\ekins\OneDrive\Documents\Inventor\Tests\OldTest1.ipt"
    files(0, 1) = "C:\Users\ekins\OneDrive\Documents\Inventor\Tests\NewTest1.ipt"
    
    files(1, 0) = "C:\Users\ekins\OneDrive\Documents\Inventor\Tests\OldTest2.ipt"
    files(1, 1) = "C:\Users\ekins\OneDrive\Documents\Inventor\Tests\NewTest2.ipt"
    
    files(2, 0) = "C:\Users\ekins\OneDrive\Documents\Inventor\Tests\OldTest3.ipt"
    files(2, 1) = "C:\Users\ekins\OneDrive\Documents\Inventor\Tests\NewTest3.ipt"
    
    files(3, 0) = "C:\Users\ekins\OneDrive\Documents\Inventor\Tests\OldTest4.ipt"
    files(3, 1) = "C:\Users\ekins\OneDrive\Documents\Inventor\Tests\NewTest4.ipt"
    
    ' Specify the folder where the assemlbies to process exist.
    Dim folder As String
    folder = "C:\Users\ekins\OneDrive\Documents\Inventor\Tests\"
    
    ' Iterate through all of the assemblies in the specified folder. This does
    ' not do subfolders.
    Dim assemblyFile As String
    assemblyFile = Dir(folder & "*.iam")
    Do While assemblyFile <> ""
        ' Open the current assembly.
        Dim asmDoc As AssemblyDocument
        Set asmDoc = ThisApplication.Documents.Open(folder & assemblyFile, False)
        
        ' Check to see if this assembly references any of the parts in the list.
        Dim refDocDesc As DocumentDescriptor
        For Each refDocDesc In asmDoc.ReferencedDocumentDescriptors
            Dim i As Integer
            For i = 0 To UBound(files, 1)
                If refDocDesc.ReferencedDocument.FullFileName = files(i, 0) Then
                    ' A match was found, so replace it.
                    refDocDesc.ReferencedFileDescriptor.ReplaceReference (files(i, 1))
                End If
            Next
        Next
        
        ' There's a bug where the display name of the occurrence doesn't always update.
        ' This resets them to the their default.
        Dim occ As ComponentOccurrence
        For Each occ In asmDoc.ComponentDefinition.Occurrences
            occ.Name = ""
        Next
        
        ' Save the assembly and close it.
        Call asmDoc.Save2(False)
        asmDoc.Close
    
        ' Get the next assembly.
        assemblyFile = Dir()
    Loop
    
    MsgBox "Finished."
End Sub

[mario170979]

thanks. But i have some problems with this code. I dont know maybe because i tried this with assemblies instead of ipt files or because the files are on a server. in the end i used this changed code (changing after: "For Each" ) which works actual but i think i have to test more and yes i know the changings are not nice and can produce errors. but couldn't solve it on a other way. i tried to give out the array item and the content of: refDocDesc and found no differenct in any letter but the code didn't use the then statement and everytime jumped inside the else statement. 

Public Sub ReplaceParts()
    ' This is used to define the list of old and new file.  The first number in
    ' Dim statement is the number of files in the list.  The number is one less
    ' than the total number since the list starts at zero.  The second number
    ' is always 1.
    '
    ' You can see where the old file and the new file are listed where each pair
    ' of files has it's own unique first index. For the second index, the old
    ' filename is 0 and the new filename is 1.
    Dim files(1, 1) As String
    files(0, 0) = "Z:\Szerver\......\Common\_ELECTRIC\_Terminalboxes\ELS Spelsberg\TK_PC_1811-9m\TK_PC_1811-9.iam"
    files(0, 1) = "Z:\Szerver\.......\Common\_ELECTRIC\_Terminalboxes\ELS Spelsberg\TK_PC_1809-8m\TK_PC_1811-9_Full-PG.iam"
    
    ' Specify the folder where the assemlbies to process exist.
    Dim folder As String
    folder = "Z:\Szerver\.....\_TESTPARTS\_Test_Replace\Assembly\"
    
    ' Iterate through all of the assemblies in the specified folder. This does
    ' not do subfolders.
    Dim assemblyFile As String
    assemblyFile = Dir(folder & "*.iam")
    Do While assemblyFile <> ""
        ' Open the current assembly.
        Dim asmDoc As AssemblyDocument
        Set asmDoc = ThisApplication.Documents.Open(folder & assemblyFile, False)
        
        ' Check to see if this assembly references any of the parts in the list.
        Dim refDocDesc As DocumentDescriptor
        Dim refDocDescString As String
        For Each refDocDesc In asmDoc.ReferencedDocumentDescriptors
            Dim i As Integer
            
            For i = 0 To UBound(files, 1)
                refDocDescString = refDocDesc.ReferencedDocument.FullFileName
                If InStr(files(i, 0), Right(refDocDescString, 10)) <> 0 Then
                    ' A match was found, so replace it.
                    MsgBox ("File Found")
                     refDocDesc.ReferencedFileDescriptor.ReplaceReference (files(i, 1))
                     
                Else
                End If
            Next
        Next
        
        ' There's a bug where the display name of the occurrence doesn't always update.
        ' This resets them to the their default.
        Dim occ As ComponentOccurrence
        For Each occ In asmDoc.ComponentDefinition.Occurrences
            occ.Name = ""
        Next
        
        ' Save the assembly and close it.
        Call asmDoc.Save2(False)
        asmDoc.Close