Hi all,

My first attempt at any macro API stuff.  I have plagiarized most of this from other posts, and have made it work for the most part.  I am stuck on 2 issues: 1) I would like to to change the custom property of both assemblies (.sldasm) & parts (.sldprt). 2) perform the function not just the folder that I specify, but any subfolders as well. (#TASK is not the answer I am looking for).

Any help is appreciated.

Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim swCustMgr As SldWorks.CustomPropertyManager

Dim fileerror As Long

Dim filewarning As Long

Dim vCustNames As Variant

Dim vCustTypes As Variant

Dim vCustVals As Variant

Dim PN As String

Dim OverwriteExisting As Integer

Dim VAL As Integer

Dim files As Variant

Const folder As String = "C:\Users\Radair.QUALITY\Documents\_RAdair Design\Purchased\Advantech\"

Sub main()

Set swApp = Application.SldWorks

files = Dir(folder & "*.sldprt", vbNormal)

Do While files <> ""

        swApp.OpenDoc6 folder & files, swDocPART, 0, "", fileerror, filewarning

        files = Dir

Set swModel = swApp.ActiveDoc

If swModel Is Nothing Then Exit Sub

'Activate Custom Prop Manager

Set swCustMgr = swModel.Extension.CustomPropertyManager("")

'Add the new property you want for this is the PartNum

VAL = swCustMgr.Add3("PartNum", swCustomInfoType_e.swCustomInfoText, "", OverwriteExisting)

'Now the FOR command will search and find the property you want to delete but first it will store its value under the PN

'then it will delete the property PartNo

'Next step will enter the stored value from the deleted property to the new one

swCustMgr.GetAll vCustNames, vCustTypes, vCustVals

For i = 0 To UBound(vCustNames)

    If vCustNames(i) = "PartNo" Then PN = (vCustVals(i))

    If vCustNames(i) = "PartNo" Then swCustMgr.Delete (vCustNames(i))

    If vCustNames(i) = "PartNum" Then vCustVals(i) = PN

    VAL = swCustMgr.Set2("PartNum", PN)

Next

swModel.Save

swApp.CloseDoc swModel.GetTitle()

    Loop

End Sub