replace text in files within subfolders

[pieros]

Hello,

I've got already some code but it works not like it should work.
What I need is a code to copy a folder with ALL subfolders and all
files in it included to a new location.
Then look in all subfolders if there are files included with the
filename "KART*.fmt".
All found files are stored in a text file.
In these files the text "530" have to be changed in "374"
Here is what I have so far:


Option Explicit

Sub UpdateFiles()

'Declareren van variabelen
Dim IFileNum As Long
Dim OFileNum As Long
Dim WholeLine As String
Dim i As Long, x As Integer
Dim TestDir As Variant
Dim RowNdx As Integer
Dim ColNdx As Integer
Dim myOutputFolder As String
Dim Regel As Integer


'Foutafhandeling
On Error Resume Next
MkDir myOutputFolder
On Error GoTo 0


'Beginnen in 1e kolom en 1e rij
ColNdx = 1
RowNdx = 1


'Start met zoeken
With Application.FileSearch
.NewSearch
.LookIn = "D:\VBA\Copy of Zoek en vervang tekst '503' in
KART-templates\Approved\" 'Zoekactie in deze folder beginnen
.SearchSubFolders = True 'Ook in subfolders zoeken
.Filename = "*KART*.fmt" 'Zoeken naar alle "KART"-templates


'Gewijzigde files schrijven naar deze locatie
myOutputFolder = "D:\VBA\Copy of Zoek en vervang tekst '503' in
KART-templates\Corrected\"


If .Execute() > 0 Then 'Ga door als "KART"-template is gevonden

ActiveCell.Range("A1").Select 'Zet cursor in excel in cel
A1
For i = 1 To .FoundFiles.Count 'Herhaal zoveel keer als dat

er "KART"-templates zijn gevonden.


IFileNum = FreeFile
Close #IFileNum
Open .FoundFiles(i) For Input As #IFileNum
'Voorbereiden voor het ophalen van tekstregels


OFileNum = FreeFile
Close #OFileNum
Open myOutputFolder & Dir(.FoundFiles(i)) For Output As

#OFileNum 'Voorbereiden voor het wegschrijven van de gewijzigde
tekstregel


TestDir = .FoundFiles(i)
TestDir = Mid(TestDir, 70, 40)


Regel = 1 'Regelteller op 1 zetten. Beginnen bij regel
1 (kan ook vanaf bv. regel 6)
While Not EOF(IFileNum) 'Zolang het einde van het
tekstfile nog niet is bereikt; ga door
Line Input #IFileNum, WholeLine 'Lees een regel in
If Len(Trim(WholeLine)) > 0 Then 'Staat er tekst in

deze regel ga dan door
If Regel = 11 And Mid(Trim(WholeLine), 13, 3)

<> "503" Then 'Als de 11e regel is bereikt EN er staat geen "503" in
Cells(RowNdx, ColNdx).Value = "De tekst
'MaxHeight = 503' is NIET gevonden in regel " & Regel & " van " &
TestDir & "." 'zet deze tekstregel dan in Excel.
ElseIf Regel = 11 And Mid(Trim(WholeLine),
13, 3) = "503" Then 'Als de 11e regel is bereikt EN er staat WEL "503"
in
Cells(RowNdx, ColNdx).Value = "De tekst
'MaxHeight = 503' is gevonden in regel " & Regel & " van " & TestDir &
"." 'zet deze tekstregel ook dan in Excel.
End If
WholeLine = Replace(WholeLine, " MaxHeight =
503;", _
" MaxHeight = 384; //503 gewijzigd in 384.
dd. 20-10-2005.") 'dd. & Date & ." is ook mogelijk
'Als "MaxHeight = 503;" voorkomt wijzig dit dan

in "MaxHeight = 384;"
Print #OFileNum, WholeLine 'Schrijf deze
gewijzigde regel naar het output file
Else
Print #OFileNum, WholeLine 'Schrijf de
ongewijzigde regel naar het output file


End If
Regel = Regel + 1 ' Regelteller verhogen


Wend
RowNdx = RowNdx + 1 'In excel een regel naar beneden
gaan


Close #IFileNum
Close #OFileNum
Next i
End If
End With


'Schrijf de excel inhoud naar tekstfile
Columns("A:A").Select
' ActiveWorkbook.SaveAs Filename:= _
' "D:\VBA\Copy of Zoek en vervang tekst '503' in
KART-templates\New\Zoek tekst '503' in files.txt" _
' , FileFormat:=xlTextMSDOS
'ActiveWorkbook.Close SaveChanges:=False
End Sub


Can anyone help me please?


Greetings,
Pieros.