Aide programme VBS ou bat

Version imprimable

Bonjour a tous je suis nouveaux ici
Je suis actuellement en stage et mon tuteur ma demander de génère un script .vbs pour lui.
En gros j'ai plusieurs dossiers nommé Test201 à Test (n) (n étant un nombre quelconque) suivant une suite logique dans chaque dossiers il y a un fichier xxx.reg
Contenue du fichier xxx.reg
; The RegSave Utility created this file
; This utility was written by Paul Hurford, Symbol EMEA TS
; You use the utility at your own risk
;
; Template File : \Application\RegSave.Reg
; Program Version : 2.20.01 May 13 2004 15:24:26
; File created 1/11/2003 00:27:58
;

[HKEY_LOCAL_MACHINE\Ident]
"Name"="Test201"

Donc ce qui ma été demander c'est que a chaque nouvelle copie du dossier Test le "Name"=Test prend la valeur du numéro du dossier
exemple
si j'ai Test202 Test 203
Code:

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 FileName = "test.reg" FindStr = """name""" & "=" & """BAM201""" ReplaceWith = """Name""" & "=" & """BAM20x""" 'Read source text file FileContents = GetFile(FileName) 'replace all string In the source file dFileContents = replace(FileContents, FindStr, ReplaceWith, 1, -1, 1) 'Compare source And result if dFileContents <> FileContents Then 'write result If different WriteFile FileName, dFileContents Wscript.Echo "Replace done." If Len(ReplaceWith) <> Len(FindStr) Then 'Can we count n of replacements? Wscript.Echo _ ( (Len(dFileContents) - Len(FileContents)) / (Len(ReplaceWith)-Len(FindStr)) ) & _ " replacements." End If Else Wscript.Echo "Text :" & FindStr & " non présent dans le fichier" End If 'Read text file function GetFile(FileName) If FileName<>"" Then Dim FS, FileStream Set FS = CreateObject("Scripting.FileSystemObject") on error resume Next Set FileStream = FS.OpenTextFile(FileName) GetFile = FileStream.ReadAll End If End Function 'Write string As a text 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 Voici un code qui lui change une chaine de caractère précise
Code:

1 2 3 4 5 6 7 8 9 10 11 12 @echo off setlocal enabledelayedexpansion set "$C:\"="xxx.reg" (for /f "delims=" %%a in ('type "Idxx.reg"') do ( set "$ligne=%%a" set "$ligne=!$ligne:%~10=%~15! echo !$ligne!) )>sortie.reg pause
Celui ci est en .bat il ne copie pas les commentaire et supprime des caractère

1 pièce(s) jointe(s)

Salut et BIENVENU le jeune étudiant sur DVP.:pc:

Quand il s'agit d'une comparaison et de remplacement d'une chaine par une autre, il faut se mettre à l'esprit que les 2 fonctions InStr et Replace sont sensibles à la casse : Pour ces 2 fonctions, Ordinateur n'est pas la même chose que ordinateur.
L'astuce est de tout transformer soit en majuscule(avec ~~UpCase~~ UCase) soit en minuscule(avec LCase) puis faire les transformations nécessaires.
Essaie avec ce listing, à savoir que le script vbs est placé dans le même dossier que celui contenant le fichier .reg à modifier :

Code:

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
Option Explicit ' <=== Déclaration très recommandée pour éviter toute ambiguïté
 
Const ForReading = 1, ForWriting = 2
Dim fso, fich, Ret, FileName, Ligne
Dim NameFolder, NewValue, nbrReplacement
nbrReplacement = 0
FileName = ".\Test205\Test.reg"
Set fso = CreateObject("Scripting.FileSystemObject")
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
MsgBox " Nombre de remplacements : " & nbrReplacement
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 
'==========================
Function Quote(StrIn)
   Quote = Chr(34) & StrIn & Chr(34)
End Function

Décompresse le zip dans le même dossier que le script(vbs).

18/01/2019, 13h19
Jordi.D

Salut merci :)
Mais j'ai un petit problème quand j'exécute le code il m'affiche un message d'erreur à la ligne 9 je ne vois pas d'où viens le problème
18/01/2019, 14h08
l_autodidacte

Que dit le message d'erreur ?
Peux-tu faire une capture de la boite de messages ?
18/01/2019, 14h13
Jordi.D

1 pièce(s) jointe(s)

Pièce jointe 442565

Voici le message d'erreur qu'il m'affiche
18/01/2019, 14h26
l_autodidacte

Le dossier Test205 est-il dans le même dossier que changement.vb (c-à-d dans Bam200) ?
Qu'as-tu écrit dans la ligne 9 ?
Où as-tu placé le fichier .reg ?
18/01/2019, 14h36
Jordi.D

Oui oui peut être que l'architecture de mon arborescence en n'est la cause
J'ai un répertoire Copier qui contient tout les dossier Test200 a 299 et chacun des dossiers contient le fichiers xxx.reg
Ligne 9 j'ai mis Le chemin et le .reg est dans le test205
18/01/2019, 14h41
l_autodidacte

Est-ce que le traitement doit se faire sur tous les fichiers xxx.reg ?

Si c'est le cas, il te faut un traitement récursif pour modifier tous les fichiers.
18/01/2019, 14h47
Jordi.D

Oui il faut que tout les fichiers prennent la valeur du dossier donc si je copie test205 test206 test 207
xxx.reg Name = test205
xxx.reg Name = test206
xxx.reg Name = test207

Essaie avec ce

Code:

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

18/01/2019, 15h56
Jordi.D

Super sa marche .!
Un grand merci à vous pour votre aide et du temps passé à m'aider aussi vraiment un grand merci je pourrais enfin avancé sur mon projet !:love: