deactivate/comment out makros in a lot of excel files

i do have several hundred of excel files. Every excel file contains a makro in the "workbooks_open" method. I want to open all these files, comment out the code, save and close the file.

a loop through all files with open/close is not a problem, but with the changing of the vba code i have no idea.

many thanks in advance!

Sub test()

Dim Path as string = "C:\123\"
Dim cDir As String
cDir = Dir(Path & "*.xlsx")
   
Do While cDir <> ""


       Application.DisplayAlerts = False
       
           '### open
           Workbooks.Open Filename:=Path & cDir


           '### here i want to deactivate/comment out the makro in the workbook_open method
         
            
            '### save
            ActiveWorkbook.Save
            ActiveWorkbook.Saved = True
    
            '### close
            ActiveWorkbook.Close False
       
        cDir = Dir
Loop


End Sub

Solution 1:

To access the code of a workbook using code, you need to allow access to the VBE via code - see https://stackoverflow.com/a/11680865/7599798 how to do so.

• You access all the coding stuff of a workbook using its VBProject-Property.
• If you want to use the Types and Constants of the Project, add a reference to Microsoft Visual Basic for Applications Extensibility
• The VBProject contains a collection of Components VBComponents, this is the list you see in the VBE in the project window, it contains all modules, classes and forms.
• The Workbook-Module has the Name ThisWorkbook and it's type = 100 (use vbext_ct_Document if you have added the mentioned reference)
• To access the code of a module, use the property CodeModule of the component.
• The lines of code can be fetched using the lines-property of CodeModule, you need to pass two parameters (startrow and numbers of rows).
• The lines-property is read only, if you want to change code, you can use the methods InsertLines, DeleteLines and ReplaceLines

Have a look to the next routine to see how it could look like. It will simply replace the Workbook_Open()-routine with Workbook_Open_BACKUP() so it will no longer fire when the workbook is opened.

Sub RemoveOnOpen(wb As Workbook)
    Dim i As Long

    With wb.VBProject
        For i = 1 to .VBComponents.Count 
            ' Debug.Print .VBComponents(i).Type, .VBComponents(i).Name
            If .VBComponents(i).Type = vbext_ct_Document And .VBComponents(i).Name = "ThisWorkbook" Then
                Dim row As Long
                For row = 1 To .VBComponents(i).CodeModule.CountOfLines
                    Dim module As CodeModule, line As String
                    Set module = .VBComponents(i).CodeModule
                    line = Trim(module.Lines(row, 1))

                    If Left(line, 27) = "Private Sub Workbook_Open()" Then
                        module.ReplaceLine row, Replace(line, "Workbook_Open()", "Workbook_Open_BACKUP()")
                    End If
                Next
            End If
        Next i
    End With
End Sub

Update: As T.M. noted, the name of the Workbook module may be different if used in a different language environment, you should check this.
I also added a Trim-statement when checking the code line for the Sub.

Solution 2:

Please, use the next Sub. It should be called by the code iterating between all workbooks to be changed:

Sub ComSpecSub(wb As Workbook, moduleName As String, strLine As String)
    Dim objThisWb As VBComponent, CodeM As CodeModule, i As Long, j As Long
    Set objThisWb = wb.VBProject.VBComponents("ThisWorkbook")
    Set CodeM = objThisWb.CodeModule
     If CodeM.Find(strLine, 1, 1, CodeM.CountOfLines, 1, False) = True Then
        For i = 1 To CodeM.CountOfLines
            If InStr(CodeM.lines(i, 1), strLine) > 0 Then
                If left(CodeM.lines(i, 1), 1) = "'" Then Exit Sub 'already commented...
                                                                  'if running the code again
                Do While i + j <= CodeM.CountOfLines
                    CodeM.ReplaceLine i + j, "'" & CodeM.lines(i + j, 1)
                    If InStr(CodeM.lines(i + j, 1), "End Sub") > 0 Then Exit Do
                    j = j + 1
                Loop
            End If
        Next i
     End If
End Sub

The above code needs a reference to 'Microsoft Visual Basic for Applications Extensibility' It should be called from your code as:

ComSpecSub ActiveWorkbook, "ThisWorkbook", "Private Sub Workbook_Open()"
    ActiveWorkbook.Close True

If adding the required reference looks problematic, please firstly run the next code, which will add it automatically:

Sub addExtenssibilityReference()
   'Add a reference to 'Microsoft Visual Basic for Applications Extensibilty 5.3':
   ThisWorkbook.VBProject.References.AddFromGuid _
        GUID:="{0002E157-0000-0000-C000-000000000046}", _
        Major:=5, Minor:=3
End Sub