HI ,Below is  my code ,  I want to convert it to run on the files in a particular folder.

is there any tool can do it ,or Modify the code can do it?

Dim swApp As Object
Dim swModel As ModelDoc2
Dim vCustInfoNameArr2 As Variant
Dim cpm As CustomPropertyManager

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

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

Dim path As String, filename As String

path = swModel.GetPathName 'Get the Path name + File Name
filename = Mid\$(path, InStrRev(path, "\") + 1) ' File Name With extension
filename = Left\$(filename, InStrRev(filename, ".") - 1) ' Remove extension

a01 = Left(filename, 13)
a02 = Right(filename, Len(filename) - 14)

cpm.Add3 "PartNo", swCustomInfoText, a01, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd ' write new value into custom properties
cpm.Add3 "Description", swCustomInfoText, a02, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd ' write new value into custom properties
cpm.Add3 "Vrsion", swCustomInfoText, "1.0.0", swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd

End Sub