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.ViewZoomtofit2

 

  swModel.ForceRebuild3 False

 

  swModel.Save2 silent

 

  swApp.CloseDoc swModel.GetTitle

 

End If

 

 

Response = Dir

Loop

 

 

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

 

 

End Sub

Outcomes