AnsweredAssumed Answered

How to export File properties into Excel

Question asked by Sengul Topuz on Dec 29, 2019
Latest reply on Jan 3, 2020 by Dan Eldred

I am tasked to create a database with parts name, revision level, material and vendor name. These information resides in the parts and drawings in Solidworks. I found a macro which I can use but gives me an error. Could you please help?

 

I pasted this into an excel VBA but it wont work.

 

Dim swApp As SldWorks.SldWorks
Dim SwModel As SldWorks.ModelDoc2
Dim swModExt As SldWorks.ModelDocExtension
Dim swAssembly As SldWorks.AssemblyDoc
Dim SwComp As SldWorks.Component2
Dim MassProp As SldWorks.MassProperty
Dim Component As Variant
Dim Components As Variant
Dim Bodies As Variant
Dim BodyInfo As Variant
Dim CenOfM As Variant
Dim RetBool As Boolean
Dim RetVal As Long
Dim xlApp As Excel.Application
Dim xlWorkBooks As Excel.Workbooks
Dim xlBook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim OutputPath As String
Dim OutputFN As String
Dim xlCurRow As Integer

Sub main()
Set swApp = Application.SldWorks
Set SwModel = swApp.ActiveDoc

If SwModel Is Nothing Then
swApp.SendMsgToUser2 "An assembly must be an active document.", swMbWarning, swMbOk
Exit Sub
End If


If SwModel.GetType <> swDocASSEMBLY Then
swApp.SendMsgToUser2 "An assembly must be an active document.", swMbWarning, swMbOk
Exit Sub

Else

Set swAssembly = SwModel

End If


Set swModExt = SwModel.Extension
Set MassProp = swModExt.CreateMassProperty
OutputPath = Environ("USERPROFILE") & "\Desktop\"
OutputFN = SwModel.GetTitle & ".xlsx"
If Dir(OutputPath & OutputFN) <> "" Then
Kill OutputPath & OutputFN
End If
Set xlApp = Excel.Application
xlApp.Visible = True
Set xlWorkBooks = Excel.Workbooks
Set xlBook = xlWorkBooks.Add()
Set xlsheet = xlBook.Worksheets("Sheet1")
xlsheet.Range("A1").Value = "File Name"
xlsheet.Range("B1").Value = "Part No"
xlsheet.Range("C1").Value = "Description"
xlsheet.Range("D1").Value = "Material"
xlsheet.Range("E1").Value = "Vendor"
xlsheet.Range("F1").Value = "Vendor No"
xlsheet.Range("G1").Value = "Revision"
xlsheet.Range("H1").Value = "Reference"

xlBook.SaveAs OutputPath & OutputFN
xlCurRow = 2
RetVal = swAssembly.ResolveAllLightWeightComponents(False)
Components = swAssembly.GetComponents(False)
For Each Component In Components
Set SwComp = Component
If SwComp.GetSuppression <> 0 Then
'If LCase(Right(SwComp.GetPathName, 3)) <> "asm" Then
Bodies = SwComp.GetBodies2(0)
'MsgBox SwComp.Name
'If Bodies <> Empty Then
RetBool = MassProp.AddBodies(Bodies)
CenOfM = MassProp.CenterOfMass

xlsheet.Range("A" & xlCurRow).Value = SwComp.Name
xlsheet.Range("B" & xlCurRow).Value = GetDefaultConfigProps(SwComp, "PartNo")
xlsheet.Range("C" & xlCurRow).Value = GetDefaultConfigProps(SwComp, "Description")
xlsheet.Range("D" & xlCurRow).Value = GetDefaultConfigProps(SwComp, "Material")
xlsheet.Range("E" & xlCurRow).Value = GetDefaultConfigProps(SwComp, "Vendor")
xlsheet.Range("F" & xlCurRow).Value = GetDefaultConfigProps(SwComp, "Vendor No")
xlsheet.Range("G" & xlCurRow).Value = GetDefaultConfigProps(SwComp, "Revision")
xlsheet.Range("H" & xlCurRow).Value = GetDefaultPartProps(SwComp, "Reference")

If LCase(Right(SwComp.GetPathName, 3)) = "asm" Then
xlsheet.Range("F" & xlCurRow).Value = "Assembly"
ElseIf LCase(Right(SwComp.GetPathName, 3)) = "prt" Then
xlsheet.Range("F" & xlCurRow).Value = "Part"
Else
xlsheet.Range("F" & xlCurRow).Value = "Undetermined"
End If 'Right 3 of file extension
xlCurRow = xlCurRow + 1


'End If 'UBound(Bodies) <> -1

'End If 'Not an Assembly
End If 'swComp.GetSuppression <> 0
Next Component

xlsheet.UsedRange.EntireColumn.AutoFit
xlBook.Save
'xlWorkBooks.Close
'xlApp.Quit
End Sub

Outcomes