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
SolidworksApi macros