AnsweredAssumed Answered

Design table not updating with VBA opened Excel Workbook

Question asked by Mike Smith on Mar 25, 2016

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



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)


        'MsgBox SelectedFile


        'cancel clicked

    End If


End With


'If SelectedFile = "" Then

'    End Sub


    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


                    swApp.CloseDoc Part.GetTitle()


                    Set designTable = Part.GetDesignTable


                    designTable.LinkToFile = False



                    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"


                        'Update Design Table link to external spreadsheet

                        xlWB.ChangeLink link, newLink, xlLinkTypeExcelLinks

                    End If



                    swApp.CloseDoc Part.GetTitle()

                End If


    End If

'End If  

End Sub