vba sample that recurses through parts in a folder and subfolders

Hi,

I admit it's been a few years but I've written vba code that builds an
array of files in a folder/sub-folder and then steps through the files
one at a time performing a sequence of commands. Problem is that code
I wrote was for MDT not SW. I'd love to see a sample of a macro that
builds an array of files - I've searched high and low with no luck.

Zander

 

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