AnsweredAssumed Answered

Select Files in Folder That Contain...

Question asked by Craig Ashmore on Dec 16, 2014
Latest reply on Dec 16, 2014 by Daniel Andersson

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.ForceRebuild3 False


  swModel.Save2 silent


  swApp.CloseDoc swModel.GetTitle


End If



Response = Dir




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



End Sub