Tekst in VBA vervangen in alle bestanden

Status
Niet open voor verdere reacties.

HJ1

Gebruiker
Lid geworden
3 sep 2021
Berichten
73
In mijn VBA script van alle bestanden moet een zoek-vervang gedaan worden maar om dit nou handmatig voor alle bestanden te doen is veel te veel werk en zou eigenlijk ook met een VBA scriptje kunnen.

Ik heb deze code al gevonden en werkend gekregen voor één bestand maar het lukt me niet om dit voor alle bestanden binnen één directory te doen.

Zo heb ik diverse xlsm bestanden in diverse submappen staan.

C:\Rapportages\Map1\
C:\Rapportages\Map2\
C:\Rapportages\Map3\
etc.

Alle xlsm bestanden moeten aangepast worden in map: C:\Rapportages\
Het gaat dus echt om de tekst in de vba, niet in het excel bestand zelf.

Code:
Sub FindReplace_WB()
'Updateby Extendoffice
    Dim ws As Worksheet
    Dim xFind As String
    Dim xRep As String
    Application.ScreenUpdating = False
    On Error Resume Next
    xFind = "Private Declare"
    xRep = "Private Declare PtrSafe"
'    xFind = Application.InputBox("Find what", "Zoek", "", , , , , 2)
'    xRep = Application.InputBox("Replace with", "Vervangen voor", "", , , , , 2)
    If xFind = "" Then
        MsgBox "wrong...", vbInformation, "Vervangen voor"
        Exit Sub
    End If
    For Each ws In ThisWorkbook.Worksheets
        ws.UsedRange.Replace What:=xFind, Replacement:=xRep, LookAt:=xlWhole
    Next ws
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub
 
Niet om het een of ander, maar je zegt dat deze code werkt binnen één bestand. Dan moet je met een loopje waarin je de bestanden uitleest (met DIR bijvoorbeeld) makkelijk alle bestanden op dezelfde manier kunnen afhandelen. Maar waar ik mij het meest over verbaas is dat je zegt dat het werkt, terwijl je code toch echt in Worksheets zoekt, en niet in modules​.

Code:
For Each ws In ThisWorkbook.[B]Worksheets[/B]
        ws.UsedRange.Replace What:=xFind, Replacement:=xRep, LookAt:=xlWhole
    Next ws
 
Je hebt helemaal gelijk, het werkte nu alleen obv de tekst in de Worksheet. Ik probeerde eerst simpel te beginnen met het vervangen in de Worksheet en daarna dit te wijzigen naar de VBA module.
Enig idee welke code je naar de VBA modules moet gebruiken?

Normaal doe ik aanpassingen in één bestand en heb totaal geen ervaring met loop actie in alle (sub)folders.


Code:
Sub folders()
Dim FileSystem As Object
    Dim HostFolder As String

    HostFolder = "C:\Rapportages\"

    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    DoFolder FileSystem.GetFolder(HostFolder)
End Sub

Sub DoFolder(Folder)
    Dim SubFolder
    Dim xFind As String
    Dim xRep As String
    Dim ws As Worksheet
    
    xFind = "Private Declare Function"
    xRep = "Private Declare PtrSafe Function"
    
    
    For Each SubFolder In Folder.SubFolders
        DoFolder SubFolder
    Next
    Dim File
    For Each File In Folder.Files
        ' Operate on each file
        
    If xFind = "" Then
        MsgBox "wrong...", vbInformation, "Private Declare PtrSafe"
        Exit Sub
    End If
    For Each ws In ThisWorkbook.VBProject.VBComponents
        ws.UsedRange.Replace What:=xFind, Replacement:=xRep, LookAt:=xlWhole
    Next ws
    Next File
    On Error GoTo 0
    Application.ScreenUpdating = True

End Sub
 
Niet om het een of ander, maar je zegt dat deze code werkt binnen één bestand. Dan moet je met een loopje waarin je de bestanden uitleest (met DIR bijvoorbeeld) makkelijk alle bestanden op dezelfde manier kunnen afhandelen. Maar waar ik mij het meest over verbaas is dat je zegt dat het werkt, terwijl je code toch echt in Worksheets zoekt, en niet in modules​.

Code:
For Each ws In ThisWorkbook.[B]Worksheets[/B]
        ws.UsedRange.Replace What:=xFind, Replacement:=xRep, LookAt:=xlWhole
    Next ws

Weet jij zo hoe je dan naar MODULES ipv Worksheet kunt verwijzen?
Bij ThisWorkbook.VBProject.VBComponents zit ik volgens mij niet echt goed. :(
 
Laatst bewerkt:
Volgens mij ben ik al een heel eind maar hij blijft volgens mij naar eigen bestand kijken....


Code:
Option Explicit
Sub folders()
Dim FileSystem As Object
    Dim HostFolder As String

    HostFolder = "C:\Rapportages\"

    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    DoFolder FileSystem.GetFolder(HostFolder)
End Sub

Sub DoFolder(Folder)
    Dim SubFolder
    Dim xFind As String
    Dim xRep As String
    Dim ws As Worksheet
    Dim md As ModuleView
    Dim theWorkbook As Workbook
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim numLines As Long ' end line
Dim lineNum As Long
Dim thisLine As String
Dim message As String
Dim numFound As Long



    xFind = "Declare Function"
    xRep = "Declare PtrSafe Function"
    
    
    For Each SubFolder In Folder.SubFolders
        DoFolder SubFolder
    Next
    Dim File
    For Each File In Folder.Files
        ' Operate on each file
        
    If xFind = "" Then
        MsgBox "wrong...", vbInformation, "Private Declare PtrSafe"
        Exit Sub
    End If
    numFound = 0
    For Each theWorkbook In Application.Workbooks
            If theWorkbook.Name <> ThisWorkbook.Name Then
            If theWorkbook.HasVBProject Then
                Set VBProj = theWorkbook.VBProject
                For Each VBComp In VBProj.VBComponents
                    'Set VBComp = VBProj.VBComponents("Module1")
                    Set CodeMod = VBComp.CodeModule

                    With CodeMod
                        numLines = .CountOfLines
                        For lineNum = 1 To numLines
                            thisLine = .Lines(lineNum, 1)
                            If InStr(1, thisLine, xFind, vbTextCompare) > 0 Then
                                message = message & theWorkbook.Name & " | " & VBComp.Name & " | Line #" & lineNum & vbNewLine
                                .ReplaceLine lineNum, Replace(thisLine, xFind, xRep, , , vbTextCompare)
                                numFound = numFound + 1
                            End If
                        Next lineNum
                    End With
                Next VBComp
            End If
        End If
    Next theWorkbook
    'For Each ws In ThisWorkbook.VBProject.VBComponents
    '
    '    ws.UsedRange.Replace What:=xFind, Replacement:=xRep, LookAt:=xlWhole
    'Next ws
    Next File
    On Error GoTo 0
    Application.ScreenUpdating = True

End Sub

"Must add a reference to "Microsoft Visual Basic For Applications Extensibility 5.3"
 
Laatst bewerkt:
Ik ben geen goede programmeur maar als ik meerdere bestanden zonder openen van buiten moet benaderen zou ik het eerder in VB.net proberen ipv VBA.
Maar misschien sla ik de plank volledig mis.
 
Je hebt zelf je probleem gecreëerd: in verschillende directories soortgelijke bestanden opslaan.
VBA, noch enige andere programmeertaal moetje gebruiken om struktuurfouten op te lossen.
Plaats alle bestanden gewoon in de directory C:\Rapportages.
Daarna wordt de code ineens supersimpel.

Dat al die bestanden VBA code hebben lijkt me overbodig.
In het personal.xlsb zet je 1 macro die op al deze soortgelijke bestanden van toepassing is.
Plaats de code waarom het gaat maar eens hier.
 
Laatst bewerkt:
Dit gaat helaas mijn kennis te boven.
xlsb bestand heb ik ook nog nooit mee te maken gehad, ook niet wetende wat het doet en wat het kan.

Die submappen zijn destijds aangemaakt om alle rapportage (XLSM bestanden) onder te verdelen per afdeling. Dit is toch niet heel gek?

Ik dacht dat ik met mijn stuk al eind op weg was maar blijkbaar niet...
 
XLSB-bestanden zijn gewone excelbestanden die alleen wat efficiënter in elkaar zitten en daardoor kleiner zijn.

Heb je de laatste zin van mijn post ook gelezen ?
 
"Plaats de code waarom het gaat maar eens hier."

Verder dan mijn huidige code kom ik op dit moment niet.
Normaal is zoek vervang in een worksheet maar in dit geval is het zoek vervang in de Modules
 
Het gaat mij om de tekst van de de code die in de afzonderlijke bestanden 'gewijzigd zou moeten worden'.
Die code kan beter als algemeen toegankelijke macro opgeslagen worden in je persoonlijke werkboek. Hoofdstuk 1 van het basisboek VBA in Excel.
Het heeft geen zin te knutselen aan een overbodige, en voor jou veel te complexe macro die je blijkbaar ergens vandaan geplukt hebt.
 
De tekst die in alle bestanden gewijzigd moet worden is:

xFind = "Private Declare Function"
xRep = "Private Declare PtrSafe Function"

Wanneer je iets in een werkblad wilt wijzigen gebruikt je "worksheet.", wat voor de code gebruik je überhaupt voor het aanroepen naar het vba?
 
Ik vroeg naar de volledige code waasrvan de te vervangen tekst een onderdeel is.
 
Doordat ik geen idee heb hoe ik dat moet programmeren heb ik diverse zoekacties gedaan, vandaar dat ik geen extra code heb dan die ik al gestuurd heb. Als ik de code had zou ik die code toch al kunnen gebruiken....

Het zijn 2 stappen;
1) zoek vervang tekst in vba (modules) .....hoe, geen idee.....
2) actie 1 doorvoeren in meerdere bestanden
 
Verwijzen naar zoeken in vba kom ik niet verder mee. Of ziet dit er ongewoon uit?
ThisWorkbook.VBProject.VBComponents

Code:
Sub folders()
Dim FileSystem As Object
    Dim HostFolder As String

    HostFolder = "C:\Rapportages\"

    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    DoFolder FileSystem.GetFolder(HostFolder)
End Sub

Sub DoFolder(Folder)
    Dim SubFolder
    Dim xFind As String
    Dim xRep As String
    Dim ws As Worksheet
    Dim md As ModuleView

    xFind = "Private Declare Function"
    xRep = "Private Declare PtrSafe Function"


    Dim File
    For Each File In Folder.Files
        ' Operate on each file
  
'      MsgBox File
    For Each ws In ThisWorkbook.VBProject.VBComponents

        ws.UsedRange.Replace What:=xFind, Replacement:=xRep, LookAt:=xlWhole
    Next ws
    Next File
'    On Error GoTo 0
'    Application.ScreenUpdating = True

End Sub
 
Zie bijlage

Hiermee zou het moeten lukken. Zie toelichting in bijlage.
 

Bijlagen

  • ChangeVBACode.xlsm
    19,4 KB · Weergaven: 15
Hiermee zou het moeten lukken. Zie toelichting in bijlage.

Geweldig dit werkt!

Nog een kleine aanvulling... het zijn een groot aantal bestanden, alleen diverse bestanden staan ook op ALLEEN LEZEN.
Wenselijk zou zijn dat bij ALLEEN LEZEN deze wordt UIT gezet, daarna actie wordt verder uitgevoerd, daarna worden op die zelfde bestanden ALLEEN LEZEN weer aangezet.


Code:
            If File.ReadOnly = False Then
                myWorkbook.Open (True)

                Set myWorkbook = Workbooks.Open(File)
                ReplaceTextInCodeModules myWorkbook
                'Save and close workbook
                myWorkbook.Close (True)
                File.ChangeFileAccess Mode:=xlReadWrite

            End If

Al deze opties loopt ie op vast.
PHP:
If File.ReadOnly = False Then
If myWorkbook.ReadOnly = False Then
If Workbook.ReadOnly = False Then
en daarna: ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite
 
Laatst bewerkt:
ReadOnly

Het ReadOnly attribuut moet gewijzigd worden vóór het openen van het bestand en na bewerken en opslaan weer teruggezet worden.
Zie Function DoFolder in bijgaande nieuwe versie.
 

Bijlagen

  • ChangeVBACode.xlsm
    19,9 KB · Weergaven: 11
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan