1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41
| Const ForReading = 1
Dim objFSO, stRep, oFld, oFile, oFileDir, FileContents, dFileContents, arrLines, tobereplaced
Set objFSO = CreateObject("Scripting.FileSystemObject")
stRep = "C:\Temp\Test"
If objFSO.FolderExists(stRep) Then
For each oFld in objFSO.GetFolder(stRep).SubFolders
For Each oFile In objFSO.GetFolder(strep & "\" & oFld.Name).Files
Set oFileDir = objFSO.OpenTextFile(oFile.Path,ForReading)
FileContents = oFileDir.ReadAll
oFileDir.Close
arrLines = Split(FileContents,vbCrLf)
tobereplaced = right(arrLines(0), len(arrLines(0)) - 6)
'Replace the string in the source file by the new one
dFileContents = replace(FileContents, tobereplaced, oFld.Name & "_" & oFile.Name)
'Compare the source and the result and perform the replacement
If dFileContents <> FileContents Then
WriteFile oFile.Path, dFileContents
End If
Next
Next
End If
'Function to replace the whole content of a file
function WriteFile(FileName, Contents)
Dim OutStream, FS
on error resume Next
Set FS = CreateObject("Scripting.FileSystemObject")
Set OutStream = FS.OpenTextFile(FileName, 2, True)
OutStream.Write Contents
End Function |
Partager