AnsweredAssumed Answered

Format BOM for Excel Export

Question asked by David Hales on Mar 29, 2019
Latest reply on Mar 29, 2019 by Artem Taturevych

I found the original macro online, and I expanded upon it quite a bit.  It takes a drawing BOM and saves it out as a CSV file, which is then converted to an Excel file.


My Problem:  If the description, or another column in my BOM has a comma in it, that throws off the CSV file, and I get an extra column when I open it in Excel.  I get the BOM through GetTableAnnotations.  My thought was to try and loop through the annotations and replace a comma with nothing for each cell string, but I cant' figure out how to navigate through annotations.  Can someone please help me with this loop?




Sub Export_BOM_As_Excel_Main()


    On Error Resume Next

    Dim swApp As SldWorks.SldWorks

    Dim swModel As SldWorks.ModelDoc2

    Dim swSelMgr As SldWorks.SelectionMgr

    Dim swTableAnn As SldWorks.TableAnnotation

    Dim swBomFeature As SldWorks.BomFeature

    Dim swAnn As SldWorks.Annotation

    Dim ActiveDocumentPath As String

    Dim vTableArr  As Variant

    Dim vTable As Variant

    Dim retval As Boolean

    Dim CSVFile As String

    Dim swCustPropMgr As SldWorks.CustomPropertyManager

    Dim ValOut As String

    Dim DwgRev As String


    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    Set swSelMgr = swModel.SelectionManager

    Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")


    ActiveDocumentPath = swModel.GetPathName ' get filename for evaluation


    If swModel Is Nothing Then ' checks to see if something is open

        MsgBox "No Drawing Loaded!", vbCritical, "Drawing Load Error"

        Exit Sub

    ElseIf swModel.GetType <> 3 Then ' checks to make sure drawing is open

        MsgBox "Current Document Is Not A Drawing!", vbCritical, "Drawing Macro Only!"

        Exit Sub

    ElseIf ActiveDocumentPath = "" Then ' check to make sure drawing has been saved

        MsgBox "Save Drawing First!", vbCritical, "Save Document Error"

        Exit Sub

    End If


    swCustPropMgr.Get5 "REVISION", True, ValOut, DwgRev, False ' get revision of drawing


    TraverseFeatureTree ' traverse tree and select BOM


    Set swBomFeature = swSelMgr.GetSelectedObject5(1) ' Make sure a BOM is selected in the feature manager design tree

    If swBomFeature Is Nothing Then Exit Sub


    vTableArr = swBomFeature.GetTableAnnotations

    For Each vTable In vTableArr

        Set swTableAnn = vTable ' Got BOM as table annotation

    Next vTable


    CSVFile = "C:\" & Left(swModel.GetTitle, InStrRev(swModel.GetTitle, " Sheet") - 3) & "_" & DwgRev & ".csv" ' Rename BOM with Rev and .csv file extension


    ' Save csv file. If you save it as an xlsx 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, ",")


    Dim FileToKill As String

    FileToKill = Left(CSVFile, Len(CSVFile) - 3) & "xlsx" ' existing excel file

    If Dir(FileToKill) <> "" Then Kill FileToKill ' delete if exists


    Set xlApp = CreateObject("Excel.Application")

    xlApp.Visible = False

    Set xlWB = xlApp.Workbooks.Open(CSVFile) ' Open the CSV file


    With xlWB.ActiveSheet

        .Range("A1").Value = "REV" ' rename header

        .Cells.EntireColumn.AutoFit ' fit column width

    End With

    xlWB.SaveAs Left(CSVFile, Len(CSVFile) - 3) & "xlsx", 51 ' and save as xlsx



    Kill CSVFile ' Get rid of .csv file


End Sub


Sub TraverseFeatureTree() ' You could even add arguments

    Dim swApp As SldWorks.SldWorks

    Dim swModel As SldWorks.ModelDoc2

    Dim swFeature As SldWorks.Feature

    Dim ModelDocType As Long

    Dim FeatureName As String


    Set swApp = Application.SldWorks ' Connect to SW

    Set swModel = swApp.ActiveDoc ' Get active document


    swModel.ClearSelection ' Clear any selection

    ModelDocType = swModel.GetType ' Get document type


    Set swFeature = swModel.FirstFeature ' Get first feature in feature tree

        While Not swFeature Is Nothing

          FeatureName = swFeature.Name

          If InStr(UCase(FeatureName), "EXCLUDE") Then ' bom excluded for hose kits

            'do nothing


                If InStr(UCase(FeatureName), "BILL OF MATERIALS") Then

                    swFeature.Select True ' Select the BOM

                    Exit Sub

                End If

            End If

            Set swFeature = swFeature.GetNextFeature ' Get next feature


End Sub