export solidworks bom to excel dab-lab
Microsoft Excel

Export SolidWorks BOM To Excel. Check it out.

If you are wondering how to export a SolidWorks type BOM to Excel, then you have come to the right place.

I have looked all over the internet and could not find the solution I was looking for, so I decided to create a macro myself to do this.

You can view each procedure/function individually by clicking the panel headers below the video

How to create a FREE 'Now TV' account. No payment details required.

or watch the video now....


Please click on the panels below to reveal or hide the macro code

In the Sub Main() you can either let the macro traverse the Feature Tree to find a BOM, or you can select it manually by clicking a BOM in the Feature Tree.

If you let the macro traverse then in the Sub TraverseFeatureTree() then rename the feature that you are looking for.

The BOM that I am looking for is called BillofMaterials2

I used the SaveAsText function, which allows you to save it as a .csv file. If you use this function and save it as an .xls file, then when you try to open it it come up with a message box. So this way it by-passes the pop up message box. It is fully automated this way.

' Written by Declan Brogan
' This macro creates an xls file from either a SolidWorks type BOM which is hard coded
' or
' by the user selecting a SolidWorks type BOM in the feature manager design tree

' Preconditions that a drawing is open and contains a SolidWorks type BOM

' You need to add references for:
' SolidWorks 20xx Type Library
' SolidWorks 20xx Constant Type Library
' Microsoft Excel XX.0 Object Libary

' Change the xx part above to the year you have on your system

    Option Explicit


Sub main()

    On Error GoTo ErrH:
    
    Dim swApp         As SldWorks.SldWorks
    
    Dim swModelDoc    As SldWorks.ModelDoc2
    
    Dim swSelMgr      As SldWorks.SelectionMgr
    
    Dim swTableAnn    As SldWorks.TableAnnotation

    Dim swBomFeature  As SldWorks.BomFeature
    
    Dim swAnn         As SldWorks.Annotation
    
    Dim vTableArr     As Variant
    
    Dim vTable        As Variant
    
    Dim retval        As Boolean
    
    Dim CSVFile       As String
    
    
    
    Set swApp = Application.SldWorks

    Set swModelDoc = swApp.ActiveDoc
    
    Set swSelMgr = swModelDoc.SelectionManager
        
    ' You can either run through the feature manager design tree and hard code in the name of a BOM
    ' So the user does not have to select a BOM evrytime
    ' Go to this function (TraverseFeatureTree) and change the name of the BOM
    ' This function will run through the feature tree and find a BOM
    ' Comment out the line below if you want to manually select a BOM in the feature tree
    TraverseFeatureTree
    
    
    ' Make sure a BOM is selected in the feature manager design tree
    Set swBomFeature = swSelMgr.GetSelectedObject5(1)
    
    
    ' Make sure a BOM is selected in the feature manager design tree
    If swBomFeature Is Nothing Then
    
        MsgBox "Please select a BOM to export"
        Exit Sub
    
    End If
    
    
    vTableArr = swBomFeature.GetTableAnnotations
        
    For Each vTable In vTableArr
        
        ' Got BOM as table annotation
        Set swTableAnn = vTable

    Next vTable
        
    ' Rename BOM with .csv file extension
    CSVFile = RenameBomToCSV
    
    
    ' Save csv file. If you save it as an xls file and try to open it in Excel and
    ' it will tell you that it is an text file.
    ' This way it actually saves as a csv file and no message box will pop up
    retval = swTableAnn.SaveAsText(CSVFile, ",")
    
    ' Now change file extension to .xls and save
    SaveCSVAsXLS CSVFile
    
    ' Get rid of .csv file
    DeleteFile (CSVFile)
    
    ' Complete process
    MsgBox "BOM processed"
    
    
    ' Clean up
    Set swBomFeature = Nothing
        
    Set swModelDoc = Nothing
        
    Set swApp = Nothing
    
    
ErrH:
    
    If Err.Number = 0 Or Err.Number = 20 Then
    
        Resume Next
        
    Else
    
        ' Type mismatch
        If swBomFeature Is Nothing Then
    
            MsgBox "Please select a BOM from the Feature Manager Tree"
            Exit Sub
    
        Else
    
            MsgBox Err.Number & " " & Err.Description
        
        End If
    
    End If
    
End Sub

In the Sub TraverseFeatureTree() change the feature that you are looking for. In the code below, where it says Bill of Materials2, change it to what ever the name of your BOM is.

By doing this it will fully automate the process with out you or the user having to select it manually in the Feature Tree.

Sub TraverseFeatureTree() ' You could even add arguments

    
    Dim swApp As SldWorks.SldWorks
    
    Dim swModelDoc As SldWorks.ModelDoc2
    
    Dim swFeature As SldWorks.Feature
    
    Dim ModelDocType As Long
    
    Dim FeatureName As String
    
    
    ' Connect to SW
    Set swApp = Application.SldWorks
    
    ' Get active document
    Set swModelDoc = swApp.ActiveDoc
    
    ' Clear any selection
    swModelDoc.ClearSelection
    
    ' Get document type
    ModelDocType = swModelDoc.GetType
    
    ' Get first feature in feature tree
    Set swFeature = swModelDoc.FirstFeature
    
    
        ' Start traversal
        While Not swFeature Is Nothing

            FeatureName = swFeature.Name
            
            Debug.Print FeatureName
                
                ' Do what you want here. I just searched the feature tree for a BOM called Bill of Materials2
                ' Change "Bill of Materials2" to the BOM of your choice
                If FeatureName = "Bill of Materials2" Then
            
                    ' Select the BOM
                    swFeature.Select True
                    
                    ' Exit early
                    Exit Sub
                
                End If
        
            ' Get next feature
            Set swFeature = swFeature.GetNextFeature
        
        Wend
    
End Sub


Once the BOM is captured then it is on to the RenameBomToCSV() function.

This function basically takes the path of the active document (the drawing) and removes the SolidWorks file extension (.slddrw) and adds the .csv file extension. I have done it this way so that eventually when the BOM is finally saved as an Excel file, it will be in the same folder where your SolidWorks drawing is saved. Hope that make sense.
Function RenameBomToCSV() As String
      
    Dim swApp         As SldWorks.SldWorks
    
    Dim swModelDoc    As SldWorks.ModelDoc2
    
    Dim GetPath       As String
    
    'clear string
    RenameBomToCSV = ""
    
    Set swApp = Application.SldWorks

    Set swModelDoc = swApp.ActiveDoc
    
    'Get full path of active document
    GetPath = swModelDoc.GetPathName
    
    'take off solidworks file extension
    GetPath = VBA.Left(GetPath, Len(GetPath) - 6)
    
    'now add csv file extension
    GetPath = GetPath & "csv"
    
    RenameBomToCSV = GetPath
    
    'clean up
    Set swModelDoc = Nothing
        
    Set swApp = Nothing

End Function


The Sub SaveCSVAsXLS speaks for itself. It has one argument passed in, which is the csv file.

If you have already run the macro then this function will delete the Excel file that is already there.

The reason for this is so that a message box does not pop up asking do you want to save over an existing file.

You can delete the lines where it says Kill FileToKill if you dont mind a message box popping up.

I do, I like things to be fuilly automated.

' Pass in the CSV file
Sub SaveCSVAsXLS(WhichDoc As String)
    
    Dim xlApp As Excel.Application

    Dim xlWB  As Excel.Workbook

    Dim FileToKill As String
    
    ' If there is an existing file the it will get deleted
    FileToKill = VBA.Left(WhichDoc, Len(WhichDoc) - 3) & "xls"
    
    Debug.Print FileToKill
    
    
    If Dir(FileToKill) <> "" Then
    
        ' Kill the existing file to stop a message popping up
        ' File already exists do you want to replace it
        ' This just make it a bit slicker
        Kill FileToKill
        
        Set xlApp = CreateObject("Excel.Application")
    
        xlApp.Visible = False
        
        ' Open the CSV file
        Set xlWB = xlApp.Workbooks.Open(WhichDoc)
        
        ' and save as xls
        xlWB.SaveAs VBA.Left(WhichDoc, Len(WhichDoc) - 3) & "xls", 56
        
        ' Show the xls file
        xlApp.Visible = True
        
    Else
        
        Set xlApp = CreateObject("Excel.Application")
    
        xlApp.Visible = False

        Set xlWB = xlApp.Workbooks.Open(WhichDoc)
    
        xlWB.SaveAs VBA.Left(WhichDoc, Len(WhichDoc) - 3) & "xls", 56
        
        xlApp.Visible = True
    
    End If
    
End Sub



I think this one is pretty self straight forward. It just deletes the csv file which is no longer needed. It is called from the Sub main procedure

Sub DeleteFile(DeleteWhichFile As String)

	Kill DeleteWhichFile

End Sub


For something a bit different, Check it out.

Have a look at my first games for android, Buzzy Bee and Buzzy Bee Expert.


Downloads page

This site is now a responsive website. Please follow the link to find out more.

responsive web design


I would be grateful for any feedback regarding this site or comments regarding the macros that I have uploaded.

HTML Comment Box is loading comments...