0 Replies Latest reply on Mar 25, 2016 11:33 AM by Mike Smith

    Design table not updating with VBA opened Excel Workbook

    Mike Smith

      I have a part with an internal design table and the cells in said design table reference an external Excel spreadsheet. I have a macro that will open the design table and update the links. One thing that I discovered tho is that the design table will not actually update unless the external spreadsheet is open my problem is that when I try to use the macro to open the spreadsheet the design table does not update....only if I open the spreadsheet either through Excel or opening it from a browser window. I am using Application.FileDialog to select the file and put it in a variable then open it using Workbooks.open(). I know that FileDialog doesn't oopen a file but only allows it to be selected. I tried to use GetOpenFilename but I was unable to change the directory that the browser window opens in even when I used ChDrive and then ChDir. I am just learning VBA so please forgive my ignorance. Any help would be appreciated. Here is my code for reference

       

      Option Explicit

       

       

      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 LayoutApp       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

      Dim swFrame         As SldWorks.Frame

      Dim vWindows        As Variant

      Dim swDocXt         As SldWorks.ModelDocExtension

      Dim SelectedFile    As String

       

      Sub main()

      Set swApp = _

      Application.SldWorks

       

      Set xlApp = _

      New Excel.Application

       

      Set LayoutApp = _

      New Excel.Application

       

      LayoutApp.Visible = True

      'Get current working directory

      workingDir = CurDir$

       

      With LayoutApp.Application.FileDialog(msoFileDialogFilePicker)

          .InitialFileName = workingDir

          .AllowMultiSelect = False

          .Title = "Select Spreadsheet to Open"

          .Filters.Add "Excel Files Only", "*.xlsx"

         

          If .Show = -1 Then

              'ok clicked

              SelectedFile = .SelectedItems(1)

              Set Layout = LayoutApp.Workbooks.Open(SelectedFile)

              Layout.Activate       

              'MsgBox SelectedFile

          Else

              'cancel clicked

          End If

       

      End With

       

      'If SelectedFile = "" Then

      '    End Sub

      'Else

          Set swFrame = swApp.Frame

          vWindows = swFrame.ModelWindows

          If Not IsEmpty(vWindows) Then

              Dim i As Integer

                  For i = 0 To UBound(vWindows)

                      Dim win As ModelWindow

                      Set win = vWindows(i)

                      Set Part = swApp.ActiveDoc

                      Set swDocXt = Part.Extension

                      If swDocXt.HasDesignTable = False Then

                          Part.Save

                          swApp.CloseDoc Part.GetTitle()

                      Else

                          Set designTable = Part.GetDesignTable

                          designTable.EditFeature

                          designTable.LinkToFile = False

                          designTable.UpdateFeature

                          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 "Link Source is up to date"

                          Else

                              'Update Design Table link to external spreadsheet

                              xlWB.ChangeLink link, newLink, xlLinkTypeExcelLinks

                          End If

                          Part.CloseFamilyTable

                          Part.Save

                          swApp.CloseDoc Part.GetTitle()

                      End If

                  Next

          End If

      'End If  

      End Sub