vba sample that recurses through parts in a folder and subfolders

I wrote this to create empty phantom part files (no features, no references) for BOM creation. The script traverses a database and creates a phantom part for each record, then adds custom properties.

Hope this helps. d

Private Sub cmdCreatePhantoms_Click() Set r = datParts.Recordset Set f = r.fields Set swApp = Nothing Set Part = Nothing Set swApp = Application.SldWorks r.movefirst Do PhantomPart$ = "\\Parts_Database\SWX_BOM\p_" + datParts.Recordset.fields("Brammo part no") + ".sldprt" PartName$ = "p_" + datParts.Recordset.fields("brammo part no") SWXModel$ = datParts.Recordset.fields("brammo part no") + ".SLDPRT" Set Part = swApp.OpenDoc6("C:\Phantom.SLDPRT", 1, 0, "", longstatus, longwarnings) Set Part = swApp.ActivateDoc2("Phantom.SLDPRT", False, longstatus) Part.SaveAs2 PhantomPart$, 0, False, False Call subUpdateProperties Part.SaveAs2 PhantomPart$, 0, False, False boolstatus = swApp.CloseAllDocuments(True) r.movenext X% = X% + 1 If X% = 15 Then Stop

Loop End Sub

Sub subUpdateProperties() Set r = datParts.Recordset Set f = r.fields Dim swApp As SldWorks.SldWorks Dim swModel As SldWorks.ModelDoc2 Dim swDraw As SldWorks.DrawingDoc Dim retval As String

Thickness$ = f("thickness") & "" PartNumber$ = f("brammo part no") & "" Description$ = f("Part Description") & "" Material$ = f("Material") & "" PartName$ = f("brammo part no") & "" Component$ = f("Component") & "" Set swApp = Application.SldWorks Set swModel = swApp.ActivateDoc2(PhantomPart$, False, longstatus) retval = swModel.AddCustomInfo3("", "Part Number", swCustomInfoText, PartName$) retval = swModel.AddCustomInfo3("", "Description", swCustomInfoText, Description$) retval = swModel.AddCustomInfo3("", "Material", swCustomInfoText, Material$) retval = swModel.AddCustomInfo3("", "MAT THICKNESS", swCustomInfoText, Thickness$) retval = swModel.AddCustomInfo3("", "Component", swCustomInfoText, Component$)

End Sub