Hello,

Currently I am trying to edit my macro to make it work on all the drawings in a specific folder. I've read up on as many discussions I could find but I just can't seem to figure it out. I'll put the working code for one at a time and the current code I came up that is failing to work on multiple files in a folder. Any examples or reworks of the code required for it to work would be extremely helpful.

The macro that works for one at a time:

Dim swApp As Object

Dim Part As Object

Dim boolstatus As Boolean

Dim longstatus As Long, longwarnings As Long

Sub main()

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")

    Set swApp = _

Application.SldWorks

    Set Part = swApp.ActiveDoc

    'swCustPropMgr.Set "Revision Letter", "1"

    swCustPropMgr.Set "Assembly #", "104500"

    swCustPropMgr.Set "Checked Date", "11JUL18"

    swCustPropMgr.Set "Check By", ""

    swCustPropMgr.Set "Effective Date", "05MAY06"

    swCustPropMgr.Set "EDR Approval Date", "25APR06"

    swCustPropMgr.Set "EDR Originated By", ""

    swCustPropMgr.Set "EDR #", "06-060"

    'swCustPropMgr.Set "Revision Description", "ORIGINAL ISSUE"

boolstatus = Part.Extension.SelectByID2("Sheet1", "SHEET", 0.158120395359656, 1.18392865868883E-02, 0, False, 0, Nothing, 0)

Part.EditTemplate

Part.EditSketch

Part.ClearSelection2 True

boolstatus = Part.Extension.SelectByID2("Sheet Formats1", "SHEET", 7.44302394941151E-03, 0.264739687978772, 0, False, 0, Nothing, 0)

boolstatus = Part.Extension.SketchBoxSelect("-0.151307", "0.048840", "0.000000", "0.261962", "-0.205311", "0.000000")

Part.SetLineColor 0

boolstatus = Part.Extension.SelectByID2("Sheet Formats1", "SHEET", 0.333181241811392, 1.37149385131569E-02, 0, False, 0, Nothing, 0)

Part.ViewZoomtofit2

Part.EditSheet

Part.EditSketch

Part.ClearSelection2 True

Part.ViewZoomtofit2

End Sub

Multiple files in a folder:

Dim swApp As Object

Dim Part As Object

Dim boolstatus As Boolean

Dim longstatus As Long, longwarnings As Long

Sub main()

    Set swApp = Application.SldWorks

    Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")

    Set swApp = _

    Application.SldWorks

    Set Part = swApp.ActiveDoc

    Path = "C:\Users\grabiem\SWIM_work\EDR-06-060_104500\Drawings\"

    sFileName = Dir(Path & "*.sldasm")

    Do Until sFileName = ""

    Set swModel = swApp.OpenDoc6(Path + sFileName, swDocASSEMBLY, swOpenDocOptions_Silent, "", nErrors, nWarnings)

    'swCustPropMgr.Set "Revision Letter", "1"

    swCustPropMgr.Set "Assembly #", "104500"

    swCustPropMgr.Set "Checked Date", "11JUL18"

    swCustPropMgr.Set "Check By", ""

    swCustPropMgr.Set "Effective Date", "05MAY06"

    swCustPropMgr.Set "EDR Approval Date", "25APR06"

    swCustPropMgr.Set "EDR Originated By", ""

    swCustPropMgr.Set "EDR #", "06-060"

    'swCustPropMgr.Set "Revision Description", "ORIGINAL ISSUE"

    boolstatus = Part.Extension.SelectByID2("Sheet1", "SHEET", 0.158120395359656, 1.18392865868883E-02, 0, False, 0, Nothing, 0)

    Part.EditTemplate

    Part.EditSketch

    Part.ClearSelection2 True

    boolstatus = Part.Extension.SelectByID2("Sheet Formats1", "SHEET", 7.44302394941151E-03, 0.264739687978772, 0, False, 0, Nothing, 0)

    boolstatus = Part.Extension.SketchBoxSelect("-0.151307", "0.048840", "0.000000", "0.261962", "-0.205311", "0.000000")

    Part.SetLineColor 0

    boolstatus = Part.Extension.SelectByID2("Sheet Formats1", "SHEET", 0.333181241811392, 1.37149385131569E-02, 0, False, 0, Nothing, 0)

    Part.ViewZoomtofit2

    Part.EditSheet

    Part.EditSketch

    Part.ClearSelection2 True

    Part.ViewZoomtofit2

    swApp.CloseDoc swModel.GetTitle

Set swModel = Nothing

sFileName = Dir

Loop

End Sub

Thanks,

Matt