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

ITEM NO.,PART NUMBER,Description,QTY.
1,B01-A57,Blade shaft,1
2,B01-A12,Top blade,1
3,B02,"Bottom blade
Fixed",1
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
        
    Else
        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"
    Else
        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)
        Next
            
    Next
        
    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 = """" & cell & """"
            End If
            rowContent = rowContent & IIf(j = 0, "", ",") & cell
        Next
        
        Print #fileNmb, rowContent
        
    Next
    
    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
    
End Function