I have this error now!
Sub main()
Dim xlApp As Object
Dim wbk As Object 'not Workbook
Dim sht As Object 'not Worksheet
'if necessary: Dim rng As Object ‹ not Range ›
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swBOMAnnotation As SldWorks.BomTableAnnotation
Dim swBOMFeature As SldWorks.BomFeature
Dim boolstatus As Boolean
Dim BomType As Long
Dim Configuration As String
Dim TemplateName As String
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
swApp.SendMsgToUser2 (' No active assembly detected. '), swMbWarning, swMbOk' test document activity
Exit Sub
ElseIf swModel.GetType <> swDocASSEMBLY Then
swApp.SendMsgToUser2 (' No active assembly detected. '), swMbWarning, swMbOk' test that the file is an assembly
Exit Sub
ElseIf swModel.GetPathName = " " Then
swApp.SendMsgToUser2 ( 'Unregistered Assembly. '), swMbWarning, swMbOk' test that assembly is registered
Exit Sub
End If
Set swModelDocExt = swModel.Extension
Set xlApp = CreateObject(" Excel.Application ")
Set wbk = xlApp.Workbooks.Open(" ... Nomenclature.xls") ' opening the template ‹ or creating a new one: Set wbk = xlApp.Workbooks.Add
‹ if required: Existing sheet selection: Set sht = wbk. Worksheets(1) ›: added a spreadsheetSet wks = wbk. Sheets.Add ›
‹ if necessary: Selecting a cell: Set rng = thisWs.Range(" A11 ") ›
TemplateName = " ... Detailed.sldbomtbt » ‹ Creating the Solidworks Automatic Bill of Materials according to model ›
BomType = swBomType_Indented
Configuration = " Default" ‹ name of the set configuration ›
Set swBOMAnnotation = swModelDocExt.InsertBomTable3(TemplateName, 0, 0, BomType, Configuration, False, swNumberingType_Detailed, False)
Set swBOMFeature = swBOMAnnotation.BomFeature
swModel.ForceRebuild3 True
Dim NumCol As Long
Dim NumRow As Long
Sun i As Long
Sun J As Long
NumCol = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount
Dim row As Long
row = 0
For i = 0 To NumRow
Dim itemNum As String, partnum As String
swBOMAnnotation.GetComponentsCount2 i + 1, "", itemNum, partnum
If isValidPart2(partnum) = False Then GoTo next_i
For J = 0 To NumCol
wbk.Sheets("Nomenclature").Cells(row + 9, J + 1) = swBOMAnnotation.Text(i + 1, J)
Next J
row = row + 1
next_i:
Next i
boolstatus = swModelDocExt.SelectByID2(swBOMFeature.GetFeature.Description, " BOMFEATURE ", 0, 0, 0, True, 0, Nothing, 0)
swModel.EditDelete
swModel.ForceRebuild3 True
Dim config As SldWorks.Configuration
Dim cusPropMgr As SldWorks.CustomPropertyManager
Dim lRetVal As Long
Dim ValOut As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Dim nNbrProps As Long
Dim vPropNames As Variant
Dim vPropTypes As Variant
Dim vPropValues As Variant
Dim resolved As Variant
Dim custPropType As Long
Dim K As Long
Dim PropertyName1 As String
Dim PropertyName2 As String
Dim PropertyName3 As String
Dim PropertyName4 As String
Dim PropertyName5 As String
Dim PropertyName6 As String
Dim PropertyName7 As String
Dim DateStr As Date
Set config = swModel.GetActiveConfiguration ': points to the solidworks properties of the current document
‹ Set cusPropMgr = config. CustomPropertyManager ›: Retrieve configuration-specific properties (Solidworks > properties> configuration-specific properties.
Set cusPropMgr = swModelDocExt.CustomPropertyManager(" ")
nNbrProps = cusPropMgr.Count
vPropNames = cusPropMgr.GetNames
For K = 0 To nNbrProps - 1
cusPropMgr.Get2 vPropNames(K), ValOut, ResolvedValOut
custPropType = cusPropMgr.GetType2(vPropNames(K))
If vPropNames(K) = "N° de projet" Then 'récupération de la propriété "N° de projet"'
NomProperty1 = ResolvedValOut
wbk.Sheets("Nomenclature").Cells(1, 3) = NomProperty1
End If
If vPropNames(K) = "N° Plan / Réf / Dim" Then
NomProperty2 = ResolvedValOut
wbk.Sheets("Nomenclature").Cells(1, 5) = "-" & NomProperty2
End If
If vPropNames(K) = "Nom de projet" Then
NomProperty3 = ResolvedValOut
wbk.Sheets("Nomenclature").Cells(3, 3) = NomProperty3
End If
If vPropNames(K) = "Désignation" Then
NomProperty4 = ResolvedValOut
wbk.Sheets("Nomenclature").Cells(5, 3) = NomProperty4
End If
If vPropNames(K) = "Dessinateur" Then
NomProperty5 = ResolvedValOut
wbk.Sheets("Nomenclature").Cells(2, 7) = " Dessinateur : " & NomProperty5
End If
If vPropNames(K) = "Vérificateur" Then
NomProperty6 = ResolvedValOut
wbk.Sheets("Nomenclature").Cells(3, 7) = " Vérificateur : " & NomProperty6
End If
If vPropNames(K) = "Indice en cours" Then
NomProperty7 = ResolvedValOut
wbk.Sheets("Nomenclature").Cells(4, 7) = " Indice en cours : " & NomProperty7
End If
Next K
wbk. Sheets(" Nomenclature "). Cells(1, 6) = " Date: " & DateValue(Now)
Dim Path As String
path = Strings.Left(swModel.GetPathName, Len(swModel.GetPathName) - 7) & " - " & PropertyName7 & " -Detailed " & " .xlsx " ' Fill in the path and record name ' & PropertyName: Added a custom property to the file name
With xlApp
.DisplayAlerts = False
.EnableEvents = False
wbk.SaveAs chemin 'enregistre le fichier et écrase si fichier déjà existant
.DisplayAlerts = True
.EnableEvents = True
wbk.Close 'ferme le workbook
.Quit 'quitte excel
End With
swApp.SendMsgToUser2 (" BOM of the entire machine created. "), swMbInformation, swMbOk 'msgbox solidworks
End Sub
Function isValidPart2(str As String) As Boolean
isValidPart2 = False
If str = "" Then Exit Function
Dim i As Long
For i = 1 To Len(str)
If Mid(str, i, 1) <> " " Then
isValidPart2 = True
Exit Function
End If
Next i
End Function
