SOLIDWORKS macro feature to link and auto update general table to Excel

{ width=350 }

This macro allows to create General Table in part, assembly and drawing and link it to external Excel or text/csv file using SOLIDWORKS API. This macro implemented as embedded macro feature which means that table will be automatically updated once the model is rebuilt.

• Run the macro
• Specify the full path to excel (.xls or .xlsx) or comma separated text file (.csv or .txt) in the first prompt dialog
• Optionally specify the name of the spreadsheet to read data from. If empty string is specified first spreadsheet will be used

Macro inserts the table and macro feature in the feature tree with the data from external file. Modify the file or general table and rebuild the model - table is updated.

Notes and limitations

• Only simple CSV files are supported (i.e. simple comma separated values, new line symbols or commas in the values are not supported)
• Excel is not required when CSV file is used
• Using CSV files has significant performance benefits as it is not required to start Excel and load document to get the data. Use this option where applicable
• Excel is displayed invisible and session may be cached for better performance benefits
• If CSV or Excel files are saved relative to the model - relative path will be maintained. It means that the SOLIDWORKS file can be moved together with Excel/CSV and link won't be broken
• If General Table is selected when inserting new feature - this table will be used instead of creating new one
• Currently it is not possible to change the path to external Excel file. Delete the macro feature instead and reinsert it by selecting the general table (see previous point)
• Macro feature is embedded into the model which means that the table will be updated on any other workstations even if this macro is not available.

Const BASE_NAME As String = "LinkedTable"

Const PARAM_EXCEL_PATH As String = "ExcelPath"
Const PARAM_SHEET_NAME As String = "SheetName"

Sub main()

    Dim swApp As SldWorks.SldWorks
    Set swApp = Application.SldWorks
    
    Dim swModel As SldWorks.ModelDoc2
    
    Set swModel = swApp.ActiveDoc
    
    If Not swModel Is Nothing Then
        
        Dim excelFilePath As String
        Dim excelSheetName As String

        excelFilePath = InputBox("Specify the full path to the excel or text/csv file")
        excelSheetName = InputBox("Specify the sheet name for excel file (specify empty string for first sheet)")
        
        If excelFilePath = "" Then
            Exit Sub
        End If
        
        excelFilePath = UpdateRelativePath(swModel, excelFilePath)
        
        Dim curMacroPath As String
        curMacroPath = swApp.GetCurrentMacroPathName
        Dim vMethods(8) As String
        Dim moduleName As String
        
        GetMacroEntryPoint swApp, curMacroPath, moduleName, ""
        
        vMethods(0) = curMacroPath: vMethods(1) = moduleName: vMethods(2) = "swmRebuild"
        vMethods(3) = curMacroPath: vMethods(4) = moduleName: vMethods(5) = "swmEditDefinition"
        vMethods(6) = curMacroPath: vMethods(7) = moduleName: vMethods(8) = "swmSecurity"
        
        Dim vParamNames(1) As String
        vParamNames(0) = PARAM_EXCEL_PATH
        vParamNames(1) = PARAM_SHEET_NAME

        Dim vParamTypes(1) As Long
        vParamTypes(0) = swMacroFeatureParamType_e.swMacroFeatureParamTypeString
        vParamTypes(1) = swMacroFeatureParamType_e.swMacroFeatureParamTypeString

        Dim vParamValues(1) As String

        vParamValues(0) = excelFilePath
        vParamValues(1) = excelSheetName

        Dim swTable As SldWorks.TableAnnotation
        Set swTable = TryGetSelectedTable(swModel)
        If swTable Is Nothing Then
            Dim emptyTable(2, 2) As String
            Set swTable = CreateTableFromArray(swModel, emptyTable)
        End If
        
        swTable.GetAnnotation().Select3 False, Nothing
        
        Dim swFeat As SldWorks.Feature
        Set swFeat = swModel.FeatureManager.InsertMacroFeature3(BASE_NAME, "", vMethods, _
            vParamNames, vParamTypes, vParamValues, Empty, Empty, Empty, _
            Empty, swMacroFeatureOptions_e.swMacroFeatureEmbedMacroFile + swMacroFeatureOptions_e.swMacroFeatureAlwaysAtEnd)
        
        If swFeat Is Nothing Then
            MsgBox "Failed to create macro runner"
        End If
        
    Else
        MsgBox "Please open model"
    End If
    
End Sub

Function UpdateRelativePath(model As SldWorks.ModelDoc2, path As String) As String
    
    Dim modelPath As String
    modelPath = model.GetPathName
    
    UpdateRelativePath = path
    
    If modelPath <> "" Then
        Dim modelDir As String
        modelDir = Left(modelPath, InStrRev(modelPath, "\"))
        
        If LCase(path) Like LCase(modelDir) & "*" Then
            UpdateRelativePath = Right(path, Len(path) - Len(modelDir) + 1)
        End If
        
    End If
    
End Function

Function GetFullPath(model As SldWorks.ModelDoc2, path As String)
    
    GetFullPath = path
    
    Dim isRelative As Boolean
    isRelative = Left(path, 1) = "\"
    
    If isRelative Then
        
        Dim modelPath As String
        Dim modelDir As String
        
        modelPath = model.GetPathName
        
        modelDir = Left(modelPath, InStrRev(modelPath, "\") - 1)
        
        GetFullPath = modelDir & path
        
    End If
    
End Function

Function TryGetSelectedTable(model As SldWorks.ModelDoc2) As SldWorks.TableAnnotation
    
    On Error Resume Next
    
    Dim swTable As SldWorks.TableAnnotation
    Set swTable = model.SelectionManager.GetSelectedObject6(1, -1)
    
    If swTable Is Nothing Then
        
        Dim swTableFeat As SldWorks.GeneralTableFeature
        Set swTableFeat = swModel.SelectionManager.GetSelectedObject6(1, -1)
        
        If Not swTableFeat Is Nothing Then
            Set swTable = swTableFeat.GetTableAnnotations()(0)
        End If
        
    End If
    
    Set TryGetSelectedTable = swTable
    
End Function

Function CreateTableFromArray(model As SldWorks.ModelDoc2, vTableData As Variant) As SldWorks.TableAnnotation
    
    Dim swTable As SldWorks.TableAnnotation
    Set swTable = model.Extension.InsertGeneralTableAnnotation(True, 0, 0, swBOMConfigurationAnchorType_e.swBOMConfigurationAnchor_BottomLeft, "", UBound(vTableData, 1), UBound(vTableData, 2))
    
    FillTable swTable, vTableData
    
    Set CreateTableFromArray = swTable
    
End Function

Sub FillTable(table As SldWorks.TableAnnotation, vTableData As Variant)
    
    Dim rowIndex As Integer
    Dim columnIndex As Integer
    
    Dim rowsCount As Integer
    Dim colsCount As Integer
    Dim i As Integer
    
    rowsCount = UBound(vTableData, 1)
    colsCount = UBound(vTableData, 2)
    
    If table.columnCount > colsCount Then
        For i = colsCount To table.columnCount - 1
            table.DeleteColumn2 table.columnCount - 1, True
        Next
    ElseIf table.columnCount < colsCount Then
        For i = table.columnCount To colsCount - 1
            table.InsertColumn2 swTableItemInsertPosition_e.swTableItemInsertPosition_Last, -1, "", swInsertTableColumnWidthStyle_e.swInsertColumn_DefaultWidth
        Next
    End If
    
    If table.rowCount > rowsCount Then
        For i = rowsCount To table.rowCount - 1
            table.DeleteRow2 table.rowCount - 1, True
        Next
    ElseIf table.rowCount < rowsCount Then
        For i = table.rowCount To rowsCount - 1
            table.InsertRow swTableItemInsertPosition_e.swTableItemInsertPosition_Last, -1
        Next
    End If
    
    For rowIndex = 0 To UBound(vTableData, 1)
        For columnIndex = 0 To UBound(vTableData, 2)
            table.Text(rowIndex, columnIndex) = vTableData(rowIndex, columnIndex)
        Next
    Next
    
End Sub

Sub GetMacroEntryPoint(app As SldWorks.SldWorks, macroPath As String, ByRef moduleName As String, ByRef procName As String)
        
    Dim vMethods As Variant
    vMethods = app.GetMacroMethods(macroPath, swMacroMethods_e.swMethodsWithoutArguments)
    
    Dim i As Integer
    
    If Not IsEmpty(vMethods) Then
    
        For i = 0 To UBound(vMethods)
            Dim vData As Variant
            vData = Split(vMethods(i), ".")
            
            If i = 0 Or LCase(vData(1)) = "main" Then
                moduleName = vData(0)
                procName = vData(1)
            End If
        Next
        
    End If
    
End Sub

Function GetArrayFromExcel(filePath As String, sheetName As String) As Variant
    
    Dim xlApp As Object
    
    Dim tableData() As String
    
    Set xlApp = GetObject("", "Excel.Application")
        
    Dim xlWorkbook As Object
    Dim xlWorksheet As Object

    Dim closeWorkbook As Boolean
    closeWorkbook = Not IsWorkbookOpen(xlApp, filePath)
    
    Set xlWorkbook = xlApp.Workbooks.Open(filePath)
    
    If sheetName <> "" Then
        Set xlWorksheet = xlWorkbook.Sheets(sheetName)
    Else
        Set xlWorksheet = xlWorkbook.Sheets(1)
    End If
    
    Dim rowIndex As Integer
    Dim columnIndex As Integer
    
    ReDim tableData(xlWorksheet.UsedRange.rows.Count, xlWorksheet.UsedRange.Columns.Count)
    
    For rowIndex = 1 To xlWorksheet.UsedRange.rows.Count
        For columnIndex = 1 To xlWorksheet.UsedRange.Columns.Count
            Dim cellVal As String
            cellVal = xlWorksheet.Cells(rowIndex, columnIndex).Value
            tableData(rowIndex - 1, columnIndex - 1) = cellVal
        Next
    Next
    
    GetArrayFromExcel = tableData
    
    If closeWorkbook Then
        xlWorkbook.Close SaveChanges:=False
    End If
    
End Function

Function GetArrayFromCsv(filePath As String) As Variant
    
    Dim fileNo As Integer

    fileNo = FreeFile
    
    Dim rows As Collection
    Set rows = New Collection
    
    Open filePath For Input As #fileNo
    
    Do While Not EOF(fileNo)
        
        Dim tableRow As String
        
        Line Input #fileNo, tableRow
            
        Dim vCells As Variant
        vCells = Split(tableRow, ",")
        rows.Add vCells
    
    Loop
    
    Close #fileNo
    
    Dim tableData() As String

    Dim rowCount As Integer
    Dim columnCount As Integer
    rowCount = rows.Count
    columnCount = UBound(rows(1)) + 1
    
    Dim rowIndex As Integer
    Dim columnIndex As Integer
    
    ReDim tableData(rowCount, columnCount)
    
    For rowIndex = 1 To rowCount
        Dim vRow As Variant
        vRow = rows.Item(rowIndex)
        
        For columnIndex = 1 To columnCount
            Dim cellVal As String
            cellVal = vRow(columnIndex - 1)
            tableData(rowIndex - 1, columnIndex - 1) = cellVal
        Next
    Next
    
    GetArrayFromCsv = tableData
    
End Function

Function IsWorkbookOpen(xlApp As Object, filePath As String) As Boolean
    
    Dim i As Integer
    
    For i = 1 To xlApp.Workbooks.Count
        If LCase(xlApp.Workbooks(i).FullName) = LCase(filePath) Then
            IsWorkbookOpen = True
            Exit Function
        End If
    Next
    
    IsWorkbookOpen = False
    
End Function

Function swmRebuild(varApp As Variant, varDoc As Variant, varFeat As Variant) As Variant

    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swFeat As SldWorks.Feature
    
    Set swApp = varApp
    Set swModel = varDoc
    Set swFeat = varFeat
    
    Dim swMacroFeat As SldWorks.MacroFeatureData
    Set swMacroFeat = swFeat.GetDefinition()
    
    Dim excelFileName As String
    Dim excelSheetName As String
    
    swMacroFeat.GetStringByName PARAM_EXCEL_PATH, excelFileName
    swMacroFeat.GetStringByName PARAM_SHEET_NAME, excelSheetName
    
    Dim vObjects As Variant
    swMacroFeat.GetSelections3 vObjects, Empty, Empty, Empty, Empty
    
    Dim swTable As SldWorks.TableAnnotation
    Set swTable = vObjects(0)
    
    If swTable Is Nothing Then
        swmRebuild = "Linked general table is missing"
        Exit Function
    End If
    
    excelFileName = GetFullPath(swModel, excelFileName)
    
    If Dir(excelFileName) = "" Then
        swmRebuild = "Linked Excel file is missing: " & excelFileName
        Exit Function
    End If
    
    Dim vTable As Variant
    
    Dim fileExt As String
    fileExt = Right(excelFileName, Len(excelFileName) - InStrRev(excelFileName, "."))
    
    Dim isExcel As Boolean
    isExcel = LCase(fileExt) = "xls" Or LCase(fileExt) = "xlsx"
    
    If isExcel Then
        vTable = GetArrayFromExcel(excelFileName, excelSheetName)
    Else
        vTable = GetArrayFromCsv(excelFileName)
    End If
    
    FillTable swTable, vTable
    
End Function

Function swmEditDefinition(varApp As Variant, varDoc As Variant, varFeat As Variant) As Variant
    swmEditDefinition = True
End Function

Function swmSecurity(varApp As Variant, varDoc As Variant, varFeat As Variant) As Variant
    swmSecurity = SwConst.swMacroFeatureSecurityOptions_e.swMacroFeatureSecurityByDefault
End Function