Tekst in VBA vervangen in alle bestanden

[HJ1]

Hij gaat bijna goed.
Wanneer je eenmaal een ALLEEN LEZEN bestand hebt gehad worden alle volgende bestanden ook op ALLEEN LEZEN gezet, zo ook de bestanden waar dit niet voor geldt.
Heb zelf nu een IF THEN toegevoegd waarin hij kijkt of bestand kenmerk ALLEEN LEZEN heeft.

Nu gaat ie alleen niet meer door alle mappen en submappen.

    For Each File In Folder.Files
        ' Operate on each file
        Debug.Print File.Name
        If UCase(FileSystem.getextensionname(File)) = "XLSM" Then
            
MsgBox File
            If File.Attributes And 1 Then
            
            If ReadOnly = True Then
                End If
                    'ReadOnly = True
                    File.Attributes = File.Attributes - 1
                
                Set myWorkbook = Workbooks.Open(File)
                ReplaceTextInCodeModules myWorkbook
                'Save and close workbook
                myWorkbook.Close (True)
                'If ReadOnly Then
                    File.Attributes = File.Attributes + 1
                'End If
            Else
                Set myWorkbook = Workbooks.Open(File)
                ReplaceTextInCodeModules myWorkbook
                'Save and close workbook
                myWorkbook.Close (True)
                If ReadOnly Then
                    File.Attributes = File.Attributes + 1
                End If
        End If
        End If
    Next

 

[AHulpje]

Hm, was vergeten ReadOnly weer False te maken.

Function DoFolder(Folder)
Dim SubFolder
Dim FileSystem As Object
Dim File
Dim myWorkbook
Dim ReadOnly As Boolean
Set FileSystem = CreateObject("Scripting.FileSystemObject")
For Each SubFolder In Folder.SubFolders
DoFolder SubFolder
Next
For Each File In Folder.Files
' Operate on each file
Debug.Print File.Name
If UCase(FileSystem.getextensionname(File)) = "XLSM" Then
If File.Attributes And 1 Then
ReadOnly = True
File.Attributes = File.Attributes - 1
End If
Set myWorkbook = Workbooks.Open(File)
ReplaceTextInCodeModules myWorkbook
'Save and close workbook
myWorkbook.Close (True)
If ReadOnly Then
File.Attributes = File.Attributes + 1
ReadOnly = False
End If
End If
Next
End Function

 

[HJ1]

Top!
Nu probeer ik nog een eindtelling toe te voegen zodat ik weet hoeveel bestanden zijn geraakt, nu krijg ik per folder een melding.

MsgBox "Aantal schrijven: " & Aantalrapportage_schrijven & "Aantal lezen: " & Aantalrapportage_lezen

Function DoFolder(Folder)
    Dim SubFolder
    Dim FileSystem As Object
    Dim File
    Dim myWorkbook
    Dim ReadOnly As Boolean
    Dim Aantalrapportage_lezen As Integer
    Dim Aantalrapportage_schrijven As Integer
    
    Set FileSystem = CreateObject("Scripting.FileSystemObject")
        For Each SubFolder In Folder.SubFolders
        DoFolder SubFolder
        Next
            For Each File In Folder.Files
            ' Operate on each file
            Debug.Print File.Name
            If UCase(FileSystem.getextensionname(File)) = "XLSM" Then
                If File.Attributes And 1 Then
                ReadOnly = True
                    File.Attributes = File.Attributes - 1
                    Aantalrapportage_lezen = Aantalrapportage_lezen + 1
                End If
            Set myWorkbook = Workbooks.Open(File)
            ReplaceTextInCodeModules myWorkbook
            'Save and close workbook
            myWorkbook.Close (True)
                If ReadOnly Then
                    File.Attributes = File.Attributes + 1
                    Aantalrapportage_schrijven = Aantalrapportage_schrijven + 1
                ReadOnly = False
                End If
        End If
    Next
 
    
End Function

 

[AHulpje]

Telling en log.

Omdat DoFolder recursief wordt aangeroepen moet je de telling buiten die functie bijhouden en tonen. Zie bijgaande nieuwe versie.
Op Blad1 wordt nu ook een log van verwerkte bestanden getoond.
Om het geheel wat flexibeler te maken zou je de te vervangen tekst en de nieuwe tekst ergens op Blad1 kunnen plaatsen (niet in kolommen A of B, daar komt de log) en daar in de macro aan te refereren, maar dat mag je zelf uitzoeken.

 

[HJ1]

Het werkt helemaal super!
Bedankt.