2 Replies Latest reply on Dec 16, 2014 1:51 PM by Daniel Andersson

    Select Files in Folder That Contain...

    Craig Ashmore

      I've pulled this code from online to replace sheet formats of drawings in a specified directory.  I'm looking to add in a parameter that searches the filename and only runs the code on the drawings within that folder that meet the criteria. 

       

      Basically I have drawings that have file names that look like this: 317-T1001-SG-1-ISO.slddrw and another might have 317-T1001-PL-1-FAB.slddrw

       

      I only want the code to run on the file names that contain "ISO" and skip ones that do not, ie "FAB"

      Below is the code: (please forgive my formatting)

       

      -------------------------------

      Option Explicit

       

      Dim swApp As SldWorks.SldWorks

      Dim swModel As ModelDoc2

      Dim swFilename As String

      Dim swDraw As SldWorks.DrawingDoc

      Dim swSheet As SldWorks.Sheet

      Dim bRet As Boolean

      Dim sPath As String

      Dim nErrors As Long

      Dim nWarnings As Long

      Dim Response As String

      Dim DocName As String

      ' Change sheet format location here

      Public Const sTemplatePath As String = "C:\Solidworks Reference\Document Templates\"

       

      Sub main()

       

      Set swApp = Application.SldWorks

       

      ' Change folder location containing the drawings to be updated here

      SheetFormat "C:\Users\Cosmos II\Desktop\Focal Point Design\Clients\HydraFab\XXX-To Library\test\", ".SLDDRW", True

       

      End Sub

       

      Sub SheetFormat(folder As String, ext As String, silent As Boolean)

       

      Dim swDocTypeLong As Long

       

      ext = UCase$(ext)

      swDocTypeLong = Switch(ext = ".SLDDRW", swDocDRAWING, True, -1)

       

      'If not a SW file, return

      If swDocTypeLong = -1 Then

      Exit Sub

      End If

       

      ChDir (folder)

       

      Response = Dir(folder)

      Do Until Response = ""

       

      swFilename = folder & Response

       

      If Right(UCase$(Response), 7) = ext Then

       

        Set swModel = swApp.OpenDoc6(swFilename, swDocTypeLong, swOpenDocOptions_Silent, "", nErrors, nWarnings)

       

        If swDocTypeLong = swDocDRAWING Then

        

      Set swDraw = swModel

          Set swSheet = swDraw.GetCurrentSheet

          

      ' Change Sheet format name here which you to put on the drawing sheet.

       

       

      sPath = sTemplatePath & "HydraFab Iso1.slddrt"

       

       

      bRet = swDraw.SetupSheet4(swSheet.GetName, swDwgPaperAsize, swDwgTemplateCustom, 1, 1, False, sPath, 0.2794, 0.2159, "Default")

       

        End If

       

        swModel.ViewZoomtofit2

       

        swModel.ForceRebuild3 False

       

        swModel.Save2 silent

       

        swApp.CloseDoc swModel.GetTitle

       

      End If

       

       

      Response = Dir

      Loop

       

       

      MsgBox "Drawing(s) Sheet Fomat Updated!!"

       

       

      End Sub