1 Reply Latest reply on Mar 11, 2016 7:25 PM by Artem Taturevych

    Loop through all open parts/assemblies

    Mike Smith

      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