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
45
46
47
| ScanDossier "C:\PersoFrancis\En VBScript et HTA\ModifPlusieursFichiers\", ".xml"
MsgBox "FAIT"
'--------------------------- Sub et Function ------------------------------------
Sub ScanDossier(ChemDoss, TypeFilename)
Dim fso, f, Element, strtext, StrPath, T
Const ForReading = 1, ForWriting = 2
Set fso = CreateObject("Scripting.FileSystemObject")
'permet de verifier si le dossier est valide ou non
On Error Resume Next
T = fso.GetFolder(ChemDoss).Files.Count
If Err.Number <> 0 Then On Error GoTo 0: Exit Sub
For Each Element In fso.GetFolder(ChemDoss).Files 'parcourir tous les fichiers du dossier
StrPath = Split(Element, "\") ' obtient le nom du fichier sans son chemin dossier
If InStr(1, Element.Name, TypeFilename) Then 'l'extension est bien celle voulue
Set f = fso.OpenTextFile(Element.Path, ForReading) 'ouvre en lecture
strtext = f.readAll: f.Close ' récupère le contenu du fichier puis le ferme
'--- appel la fonction qui va faire le remplacement ---
strtext = remplacer(strtext, "ABCDEFGHIJKLM", "tgtguid=" & Chr(34) & "{", "}")
If strtext <> "" Then ' Ok pas de problème, les balise début et fin ont été trouvé
Set f = fso.OpenTextFile(Element.Path, ForWriting) 'ouvre le fichier en écriture
f.Write strtext: f.Close ' remplace le contenu modifié du fichier puis le ferme
End If
Set f = Nothing
End If
Next
Set fso = Nothing
End Sub
Function remplacer(RechDans, MotDeRemplacement, BaliseDeb, BaliseFin)
Dim pos, posdeb, motrecupe
pos = 0: remplacer = ""
pos = InStr(pos + 1, RechDans, BaliseDeb, vbTextCompare) 'recherche de la position de la balise de début
If pos <> 0 Then 'la balise debut a été trouvé
posdeb = pos + Len(BaliseDeb) 'calage au debut du mot à remplacer
pos = InStr(posdeb, RechDans, BaliseFin, vbTextCompare) 'recherche de la position de la balise de fin
If pos <> 0 Then 'la balise fin a été trouvé
motrecupe = Mid(RechDans, posdeb, pos - posdeb)'extraction du mot à remplacer
'effectue le remplacement de tous les motrecupe par MotDeRemplacement
remplacer = Replace(RechDans, motrecupe, MotDeRemplacement, 1, -1, vbTextCompare)
End If
End If
End Function |
