Apply a macro to an entire folder

Macro
1

Hello

I would like to apply the following macro that works well to all the clips stored in a folder.

I have made several attempts without success knowing that I am a beginner and I am trying to copy existing models.

Thank you in advance for your answer


2022-04-29_15h07_54.png
2 

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Public CheckCurV As String
Dim RevTable As Object
Dim CurrentRevision As String

Sub MAIN()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc


  
' Get Current Revision
  CheckCurV = Part.CustomInfo2("", "Current Revision")
  
  
' Get Revision Table
  Set RevTable = Part.GetCurrentSheet.RevisionTable
  If RevTable Is Nothing Then MsgBox "No revision table is available!", vbExclamation: End

' Add Row to Revision Table
  RevTable.AddRevision (CheckCurV)
    nNumCol = RevTable.ColumnCount - 4
    'nNumRow = RevTable.RowCount - 1

' Interface to add values to new row on the Revision Table
  RevTable.Text(0, nNumCol) = "28.04.22" 'InputBox("Date." & Chr$(13) & Chr$(13) & "| *REV* |Description|Rev By|Date|" & Chr$(13) & "____________________________________________" & Chr$(13), "Revision", CheckCurV)

  'RevTable.Text(0, nNumCol + 1) = InputBox("Enter the Revision number or letter." & Chr$(13) & Chr$(13) & "| *REV* |Description|Rev By|Date|" & Chr$(13) & "____________________________________________" & Chr$(13), "Revision", CheckCurV)

  RevTable.Text(0, nNumCol + 2) = "Changement de matiere en 441" 'InputBox("Enter the description of the revision." & Chr$(13) & Chr$(13) & "|Rev| *DESCRIPTION* |Rev By|Date|" & Chr$(13) & "____________________________________________", "Description", "ECO- ")

  RevTable.Text(0, nNumCol + 3) = "YP" 'InputBox("Enter the revision creator's initials." & Chr$(13) & Chr$(13) & "|Rev|Description| *REV BY* |Date|" & Chr$(13) & "____________________________________________", "Rev By", "IP")

' Apply new value for Current Revision
  Part.CustomInfo2("", "Current Revision") = RevTable.Text(nNumRow, nNumCol)

' Force Rebuild
  boolstatus = Part.ForceRebuild3(False)

End Sub

 

1 Like
3

Hello
You can do this with Integration if you have the MyCadTools.

If not with the code, you have to start with that.

4

Thank you I used MyCadTools integration

1 Like