12 Replies Latest reply on May 21, 2013 12:59 PM by Jack Berryman

    Run macro on all *.SLDLFP files in a directory, including subdirectories.

    Jack Berryman

      Hi All,

       

      How do I go about running the following macro on all *.SLDLFP files in the weldment profile directory - including all files in all subfolders.

       

       

      Dim swApp As SldWorks.SldWorks
      Dim modelDoc As SldWorks.ModelDoc2
      
       Sub main()
      Dim cusPropMgr As SldWorks.CustomPropertyManager
      Dim retDetails As String
      Dim retDescription As String
      Dim retval As Integer
      Set swApp = Application.SldWorks
      Set modelDoc = swApp.ActiveDoc
      Set cusPropMgr = modelDoc.extension.CustomPropertyManager("")
      'with this code you add a new custom property
      retDescription = cusPropMgr.Get("Description")
      retval = cusPropMgr.Add2("Details", swCustomInfoText, retDescription)
      retval = cusPropMgr.Set("Details", retDescription)
      'if you want to change an existing custom property use the code below
      'retval = cusPropMgr.Set("New Number", "9")
      End Sub
      
      

       

      Thank you all so much in advance!

       

      Regards,

       

      Jack

        • Re: Run macro on all *.SLDLFP files in a directory, including subdirectories.
          Santosh Pawar

          Sub main()
              Set swApp = Application.SldWorks
              loopFolder folderPath
              swApp.ExitApp
          End Sub

          Sub loopFolder(ByVal strInputFolderPath As String)
              If Not Right(strInputFolderPath, 1) = "\" Then
              strInputFolderPath = strInputFolderPath & "\"
              End If
              process (strInputFolderPath)
              Dim fso As FileSystemObject
              Dim folder As Scripting.folder
              Dim Subfolder As Scripting.folder
             
              Set fso = New Scripting.FileSystemObject

              Set folder = fso.GetFolder(strInputFolderPath)
             
              For Each Subfolder In folder.SubFolders
                  loopFolder Subfolder.Path
              Next
             
          End Sub

          Sub process(ByVal strInputFolderPath As String)

                  strFileName = Dir(strInputFolderPath & "*.SLDLFP")

                  While strFileName <> ""
                      '''''''''********Your code         
                      swApp.QuitDoc swModel.GetTitle
                      strFileName = Dir
                  Wend
          End Sub

           

          You need to add the Microsoft Scripting Runtime in references.

          I hope this helps.

            • Re: Run macro on all *.SLDLFP files in a directory, including subdirectories.
              Jack Berryman

              Thank you so much for the quick reply Santosh!

               

              I've inserted my code in to your code, and enabled the Microsoft Scripting Runtime but im getting an error 424 object required at:

               

              swApp.QuitDoc swModel.GetTitle

               

              This is the code so far:

              Dim swApp As SldWorks.SldWorks

              Dim modelDoc As SldWorks.ModelDoc2

               

               

              Sub main()

                  Set swApp = Application.SldWorks

                  loopFolder folderPath

                  swApp.ExitApp

              End Sub

              Sub loopFolder(ByVal strInputFolderPath As String)

                  If Not Right(strInputFolderPath, 1) = "\" Then

                  strInputFolderPath = strInputFolderPath & "\"

                  End If

                  process (strInputFolderPath)

                  Dim fso As FileSystemObject

                  Dim folder As Scripting.folder

                  Dim Subfolder As Scripting.folder

                 

                  Set fso = New Scripting.FileSystemObject

                  Set folder = fso.GetFolder(strInputFolderPath)

                 

                  For Each Subfolder In folder.SubFolders

                      loopFolder Subfolder.Path

                  Next

                 

              End Sub

              Sub process(ByVal strInputFolderPath As String)

                      strFileName = Dir(strInputFolderPath & "*.SLDLFP")

                      While strFileName <> ""

                     

                          '''''''''

                         

              Dim cusPropMgr As SldWorks.CustomPropertyManager

              Dim retDetails As String

              Dim retDescription As String

              Dim retval As Integer

              Set swApp = Application.SldWorks

              Set modelDoc = swApp.ActiveDoc

              Set cusPropMgr = modelDoc.extension.CustomPropertyManager("")

              'with this code you add a new custom property

              retDescription = cusPropMgr.Get("Description")

              retval = cusPropMgr.Add2("Details", swCustomInfoText, retDescription)

              retval = cusPropMgr.Set("Details", retDescription)

              'if you want to change an existing custom property use the code below

              'retval = cusPropMgr.Set("New Number", "9")

               

               

                          '''''''''

                         

                          swApp.QuitDoc swModel.GetTitle

                          strFileName = Dir

                      Wend

              End Sub

               

              Thanks again Santosh.

            • Re: Run macro on all *.SLDLFP files in a directory, including subdirectories.
              Patrick O'Hern

              Here is a sub I use to get files in a folder and subfolders

               

               

              Sub ListMyFiles(strSourcePath As String, bSubFolders As Boolean)
                  Dim oFSO As New FileSystemObject

                  Dim oSource As Object

                  Dim oFileName As Object

                  Dim oSubFolder As Object

                 

              'Get reference folder

                  Set oSource = oFSO.GetFolder(strSourcePath)

              'Resume macro on error

                  On Error Resume Next

              'Step through all files in reference folder

                  For Each oFileName In oSource.Files

                      If right(oFileName.Path, 6) = "SLDDRW" Then  'Check if current file is a drawing

                      'Reset file update status

                          bUpdated = False

                      'Open current file

                          Set swModel = swApp.OpenDoc6(oFileName.Path, swDocDRAWING, swOpenDocOptions_Silent, _

                              "", lngErrors, lngWarnings)

                         

                          If Not swModel Is Nothing Then  'Check if file was opened

                          'Show file path

                              Debug.Print swModel.GetPathName

                             

                              Call UpdateSettings  'Process current file

                              

                              If bUpdated = True Then  'Check if file was updated

                              'Save current file

                                  bStatus = swModel.Save3(swSaveAsOptions_Silent, lngErrors, lngWarnings)

                              'Add filename to list of updated files

                                  frmUpdatedFiles.lboFiles.AddItem right(swModel.GetPathName, Len(strRefPath) + 1)

                              End If

                          'Close current file

                              swApp.CloseDoc (swModel.GetPathName)

                          End If

                      End If

                  Next

                 

                  If bSubFolders = True Then  'Check if user request to process sub-folders

                  'Step through sub-folders in reference folder

                      For Each oSubFolder In oSource.SubFolders

                          Call ListMyFiles(oSubFolder.Path, bSubFolders)  'Find files in sub-folder

                      Next

                  End If

              End Sub