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 42 43 44
| Option Explicit ' <=== Déclaration très recommandée pour éviter toute ambiguïté
Const ForReading = 1, ForWriting = 2
Dim fso, fich, Ret, FileName, Ligne, objFolder, SubFold, F
Dim NameFolder, NewValue, nbrReplacement
nbrReplacement = 0
'FileName = ".\Test205\Test.reg" ' Changement de stratégie : FileName doit être lu à partir du dossier qui le contient
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = fso.GetFolder(".") ' Le point indique le dossier en cours, où on place le script(Changement.vbs)
' Pour ton cas, il faut placer le script dans le dossier "Copier"
For Each SubFold In objFolder.SubFolders
' Si le dossier du fichier .reg est de forme BAMxxx, mets "bam" à la place de "test" dans la ligne suivante
If InStr(1, LCase(SubFold.Name), "test", vbTextCompare) > 0 Then
For Each F In SubFold.Files
If LCase(fso.GetExtensionName(F.Name)) = "reg" Then
FileName = F.Path
NameFolder = fso.GetFolder(fso.GetFile(FileName).ParentFolder).Name
NewValue = Quote("Name") & "=" & Quote(NameFolder) ' Nouvelle ligne à écrire
Set fich = fso.OpenTextFile(FileName, ForReading, False)
Do While Not Fich.AtEndOfStream
Ligne = Trim(Fich.ReadLine)
If InStr(1, LCase(Ligne),Quote("name") & "=" & Chr(34) & "test", vbTextCompare) > 0 _
And InStr(1, Ligne, NameFolder, vbTextCompare) = 0 Then ' dans ce cas, on remplace la ligne lue par NewValue
Ligne = NewValue
nbrReplacement = nbrReplacement + 1 ' Compteur pour les remplacements
End If
Ret = Ret & Ligne & vbNewLine
Loop
fich.Close ' On doit fermer le fichier car on va l'utiliser en écriture
Set fich = fso.OpenTextFile(FileName, ForWriting, True)
Ret = Left(Ret, Len(Ret) - 2) ' On supprime le dernier retour chariot (vbNewLine)
fich.Write Ret
fich.Close ' On fermer le fichier
End If
Next
End If
Ret = "" ' Sans cette instruction, Ret sera le cumule de tout ce qui a été lu à partir de tous les fichiers .reg
Next
MsgBox " Nombre de remplacements dans tous les fichiers : " & nbrReplacement
'==========================
Function Quote(StrIn)
Quote = Chr(34) & StrIn & Chr(34)
End Function |
Partager