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

    xlApp.Quit

 

    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

            Else

                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

        Wend

End Sub

Outcomes