AnsweredAssumed Answered

Add Custom Property to every file in a folder

Question asked by Geoff Hockin on May 11, 2017
Latest reply on May 11, 2017 by Deepak Gupta



My Problem: I am trying to add a custom property to every file in a folder.


Background: I am using old CAD files for a new job which will have new part numbers but I would like to have the reference of the old part number in case someone needs to go back and check something. I am very new to macros so I have been piecing them together from other info I have found on the forum. I have a macro that will update the custom property of file I have open. It works nicely and I am now try to expand that to have it automatically open every file in the folder I define and update the custom property.


Right now my new macro almost works. My challenge is the "Dir()" command does not seem increment to the next file in the directory. It grabs the same file and keeps opening that same file, eventually timing out after 5 loops.


Any Help to solve this problem would be greatly appreciated. Thank you in advance for your time.


See code below:


Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim fileerror As Long
Dim filewarning As Long


Const Folder As String = "C:\Users\test macro\"

Dim FileName As String
Dim PartNo As String
Dim retval As String

Sub main()

Set swApp = Application.SldWorks


'returns filename with specified extension. If more than one *.sldprt file exists, the first file found is returned
FileName = Dir(Folder & "*.sldprt")


While FileName <> ""

        'Open document with stored file name in called out folder
        Set swModel = swApp.OpenDoc6(Folder & FileName, swDocPART, Empty, Empty, fileerror, filewarning)
        'sets PartNo variable equal to the document name
        PartNo = swModel.GetTitle
        'adds custom property with PartNo variable
        retval = swModel.AddCustomInfo3("", "OLD PART NUMBER", swCustomInfoText, PartNo)
        'save file
        swModel.Save3 0, 0, 0
        'close the window
        swApp.QuitDoc swModel.GetTitle
        ' Call Dir again without arguments to return the next *.SLDPRT file in the
        ' same directory.
        FileName = Dir()

MsgBox "Completed Custom Property Update"


'Exit solidworks App. (commented out while troubleshooting)
End Sub