0 Replies Latest reply on Aug 28, 2015 5:21 AM by MA Thieu

    BOM export macro problem

    MA Thieu

      Hello all!

      A friend made me a macro to export a BOM from a drawing in Excel (CSV format). My problem: I need that macro can add a new table for each execution. I can't find how I can do that. For exemple: My drawing have a 3 line BOM. I run the macro once, it works properly.

      But I need a new table (same) at the end of the previous if I run again the macro. How can I modify this code????


      This is ma actual code:


      Dim swApp As SldWorks.SldWorks

      Dim swModel As SldWorks.ModelDoc2


      Sub main()


          Dim swFeat As SldWorks.Feature

          Dim swBomFeat As SldWorks.BomFeature


          'Application SW

          Set swApp = Application.SldWorks


          'Document actif

          Set swModel = swApp.ActiveDoc

          Debug.Print "Document : " & swModel.GetTitle


          'Récupération de la première fonction

          Set swFeat = swModel.FirstFeature


          'Parcours des autres fonctions

          Do While Not swFeat Is Nothing


              'Récupération des fonction de type Nomenclature (BOM)

              If "BomFeat" = swFeat.GetTypeName Then


                  Debug.Print "Fonction : " & swFeat.Name


                  Set swBomFeat = swFeat.GetSpecificFeature2



                  ProcessBomFeature swBomFeat


              End If


              Set swFeat = swFeat.GetNextFeature





          vTableArr = swBomFeat.GetTableAnnotations



      End Sub


      Sub ProcessBomFeature(swBomFeat As SldWorks.BomFeature)


          Dim vTableArr As Variant

          Dim vTable As Variant

          Dim swTable As SldWorks.TableAnnotation

          Dim swAnn As SldWorks.Annotation

          Dim nNumCol As Long

          Dim nNumRow As Long

          Dim sRowStr As String

          Dim i As Long

          Dim j As Long


          'Récupération des tables d'annotation

          vTableArr = swBomFeat.GetTableAnnotations


          'Parcours des tables d'annotation

          For Each vTable In vTableArr


              'Récupération d'une table

              Set swTable = vTable


              'Récupération des contenus

              Set swAnn = swTable.GetAnnotation


              'Nombre de colonne et de ligne

              nNumCol = swTable.ColumnCount

              nNumRow = swTable.RowCount


              'Nom et type de table

              Debug.Print "    Table : " & swAnn.GetName & " Type : " & swTable.Type


              'Parcours des lignes

              For i = 0 To nNumRow - 1


                  sRowStr = "      "


                  'Parcours des colonnes

                  For j = 0 To nNumCol - 1


                      sRowStr = sRowStr & swTable.Text(i, j) & " | "


                  Next j


              ' Affichage du contenu

              Debug.Print Left(sRowStr, Len(sRowStr) - 1)


              Next i




              'Dossier de sortie

              Dim xlsPath As String

              xlsPath = Mid(swModel.GetPathName, 1, InStrRev(swModel.GetPathName, "\"))


              'Nom du XLS

              Dim xlsName As String

              If InStrRev(swModel.GetTitle, ".") > 0 Then

                  xlsName = Mid(swModel.GetTitle, 1, InStrRev(swModel.GetTitle, ".") - 1) & ".csv"


                  xlsName = swModel.GetTitle & ".csv"

              End If


              Debug.Print "Sortie : " & xlsPath & xlsName


              'Export Excel

              swTable.SaveAsText xlsPath & xlsName, ";"


          Next vTable


          MsgBox "Export terminé"


      End Sub


      Could anyone help me??