5 Replies Latest reply on May 11, 2017 2:33 PM by Deepak Gupta

    Add Custom Property to every file in a folder

    Geoff Hockin



      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