Export SOLIDWORKS table to CSV using VBA macro

More 'Goodies'

This macro exports the selected table to the CSV (Comma Separated Values) file using SOLIDWORKS API. This functionality is similar to built-in 'Save As' option for table:

Save As option for tables
Save As option for tables

However macro preserves the special symbols like commas, quotes or new line symbols and properly escapes them according to the CSV specification:

Bill Of Materials with special symbols (comma and new line)
Bill Of Materials with special symbols (comma and new line)

So the file can be later properly read using the CSV readers like MS Excel;

CSV file imported to Excel
CSV file imported to Excel

For the above example BOM table the macro will generate the following output:

1,B01-A57,Blade shaft,1
2,B01-A12,Top blade,1
3,B02,"Bottom blade
4,R1284,Blade rivets,4
5,E25-E16,"Blade extension, Plastic",1

Macro can be configured by modifying the value of the constants

Const OUT_FILE_PATH As String = "D:\bom.csv" 'Full path to the output CSV file
Const INCLUDE_HEADER As Boolean = True 'True to include the table header, False to only include data

Specify empty string as the OUT_FILE_PATH variable value to export table with the same name as original file into the same folder

For example for the table in the D:\MyDrawing\Draw001.slddrw file the below setting would save the file into the D:\MyDrawing\Draw001.csv location.

Const OUT_FILE_PATH As String = ""

Const OUT_FILE_PATH As String = "D:\bom.csv" 'empty string to save in the model's folder
Const INCLUDE_HEADER As Boolean = True

Dim swApp As SldWorks.SldWorks

Sub main()

    Set swApp = Application.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Set swModel = swApp.ActiveDoc
    If Not swModel Is Nothing Then
        Dim swTableAnn As SldWorks.TableAnnotation
        Set swTableAnn = swModel.SelectionManager.GetSelectedObject6(1, -1)
        Dim vTable As Variant
        vTable = GetTableData(swTableAnn, INCLUDE_HEADER)
        WriteCsvFile GetExportFilePath(swModel), vTable
        MsgBox "Please open document"
    End If
End Sub

Function GetExportFilePath(model As SldWorks.ModelDoc2) As String
    If OUT_FILE_PATH = "" Then
        Dim modelPath As String
        modelPath = model.GetPathName
        If modelPath = "" Then
            Err.Raise vbError, "", "Model is not saved. Specify the full path to save a table or save the model"
        End If
        GetExportFilePath = Left(modelPath, InStrRev(modelPath, ".")) + "csv"
        GetExportFilePath = OUT_FILE_PATH
    End If
End Function

Function GetTableData(tableAnn As SldWorks.TableAnnotation, includeHeader As Boolean) As Variant
    Dim tableData() As String
    Dim i As Integer
    Dim j As Integer
    Dim offset As Integer
    offset = IIf(INCLUDE_HEADER, 0, 1)
    For i = 0 + offset To tableAnn.RowCount - 1
        ReDim Preserve tableData(tableAnn.RowCount - 1 - offset, tableAnn.ColumnCount - 1)
        For j = 0 To tableAnn.ColumnCount - 1
            tableData(i - offset, j) = tableAnn.Text(i, j)
    GetTableData = tableData
End Function

Sub WriteCsvFile(filePath As String, table As Variant)
    Dim fileNmb As Integer
    fileNmb = FreeFile
    Open filePath For Output As #fileNmb
    Dim i As Integer
    Dim j As Integer
    For i = 0 To UBound(table, 1)
        Dim rowContent As String
        rowContent = ""
        For j = 0 To UBound(table, 2)
            Dim cell As String
            cell = table(i, j)
            If HasSpecialSymbols(cell) Then
                cell = """" & ReplaceSpecialSymbols(cell) & """"
            End If
            rowContent = rowContent & IIf(j = 0, "", ",") & cell
        Print #fileNmb, rowContent
    Close #fileNmb
End Sub

Function HasSpecialSymbols(cell As String) As Boolean
    HasSpecialSymbols = InStr(cell, ",") > 0 Or InStr(cell, vbLf) > 0 Or InStr(cell, vbNewLine) > 0 Or InStr(cell, """") > 0
End Function

Function ReplaceSpecialSymbols(cell As String) As String
    cell = Replace(cell, """", """""")
    ReplaceSpecialSymbols = cell
End Function

Product of Xarial Product of Xarial