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 = _

Application.SldWorks

 

'Get current working directory

workingDir = CurDir$

 

Set Part = swApp.ActiveDoc

 

Part = swApp.GetDocuments

    For i = 0 To UBound(Part)

        Set designTable = Part.GetDesignTable

        designTable.Attach

        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"

 

        Else

 

            'Update Design Table link to external spreadsheet

            xlWB.ChangeLink link, newLink, xlLinkTypeExcelLinks

 

        End If

      

        Part.CloseFamilyTable

        Part.Save

        Part.Close

     Next i

 

End Sub

Outcomes