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
'Traitement
ProcessBomFeature swBomFeat
End If
Set swFeat = swFeat.GetNextFeature
Loop
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"
Else
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??
Thanks
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
'Traitement
ProcessBomFeature swBomFeat
End If
Set swFeat = swFeat.GetNextFeature
Loop
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"
Else
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??
Thanks