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

      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