AnsweredAssumed Answered

Loop through all open parts/assemblies

Question asked by Mike Smith on Mar 11, 2016
Latest reply on Mar 11, 2016 by Artem Taturevych

I have a macro that works on its own but it only works on the active part or assembly. I want to add a loop that will perform the action on all of the open part/assembly files.

Also can't seem to get the macro to close the active part after saving it. Here is what I have so far.


Dim swApp           As SldWorks.SldWorks

Dim Part            As SldWorks.ModelDoc2

Dim newLink         As Variant

Dim currentLink     As Variant

Dim designTable     As SldWorks.designTable

Dim xlApp           As Excel.Application

Dim xlWS            As Excel.Worksheet

Dim xlWB            As Excel.Workbook

Dim Layout          As Excel.Workbook

Dim link            As String

Dim fileName        As String

Dim workingDir      As String


Sub main()

Set swApp = _



'Get current working directory

workingDir = CurDir$


Set Part = swApp.ActiveDoc


Part = swApp.GetDocuments

    For i = 0 To UBound(Part)

        Set designTable = Part.GetDesignTable


        Set xlWS = designTable.Worksheet

        Set xlWB = designTable.Worksheet.Parent


        'Get current links to external Excel Spreadsheet

        currentLink = xlWB.LinkSources(xlExcelLinks)

        link = Join(currentLink)


        fileName = Mid(link, InStrRev(link, "\"))


        'Get the current working directory and add the filename the link will be updated to

        newLink = workingDir & fileName


        If StrComp(link, newLink, vbTextCompare) = 0 Then


        MsgBox "Links are up to date"




            'Update Design Table link to external spreadsheet

            xlWB.ChangeLink link, newLink, xlLinkTypeExcelLinks


        End If





     Next i


End Sub