Script pour archiver les fichiers les plus récents de mon ordinateur.

Version imprimable

comment faire un script pour compressé des fichiers dans un dossier d’archivage de sauvegarde. La condition à respecter : les fichiers dans un dossier doivent être les plus récent, on n’archive pas les vieux fichiers mais leur date de création ou de modification doit être supérieur à une date d’un fichier x donné. Par exemple : mon fichier donnée se trouve dans le C:\\sauvegarde et il a comme date le 20/05/2014 alors je dois archiver les fichiers du 14/05/2014 au 20/05/2014. Je pense il faut faire un script VBS comme je l’ai fait pour la suppression des vieux fichiers (remplacer clean par copy mais je n’y parviens pas)
Voici le script pour la suppression des fichiers :

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
 'Initialisation du nom du fichier
   sFileName = "T:\PRO\Sauvegarde\testFichierEfface\Verification\Verification_Sauvegarde.txt"
 
 ' Récupérer l'instance du fichier.
   Set fso = CreateObject("Scripting.FileSystemObject")
 
 ' On récupére la date de modification du fichier .txt ou la date de la dernière sauvegarde est inscrite
If fso.FileExists("T:\PRO\Sauvegarde\testFichierEfface\Verification\Verification_Sauvegarde.txt" ) = True Then 
 Set oFile = fso.GetFile("T:\PRO\Sauvegarde\testFichierEfface\Verification\Verification_Sauvegarde.txt" ) 
 dtmDateModifie = oFile.DateLastModified
 Set oFolder = Nothing 
Else 
 dtmDateModifie = "Unknown" 
End if 
 
‘Repertoire ou sont stockés les fichiers 
DossierSauvegarde = "T:\PRO\Sauvegarde\testFichierEfface" 
 
'Nombre de jours de conservation des Fichiers  (28 jours)
AgeMaximalFichiers = "28" 
 
'Comptage des fichiers effaces 
NbFichiersEffaces = 0 
NbDossiersEffaces = 0
 
'Nom du Fichier  Log  suivant  La Date  systeme
LogFile_Date = "FichierLog_" & Day(Now) & "_" & Month(Now) & "_" & Year(Now)
 
'Initialisation des objets 
Set fso = CreateObject("Scripting.FileSystemObject" )
if not fso.fileExists("T:\PRO\Sauvegarde\testFichierEfface\logs\" & LogFile_Date & ".txt") Then
Set OutPut = fso.CreateTextFile("T:\PRO\Sauvegarde\testFichierEfface\logs\" & LogFile_Date & ".txt",8)
OutPut.WriteLine "*************************************************************************************************"
OutPut.WriteLine "Nous sommes Le " &  Day(Now) & "/" & Month(Now) & "/" & Year(Now)& " La liste des Fichiers Supprimés a cette heure " & Time & " est :"  
OutPut.WriteLine "*************************************************************************************************"
else
Set OutPut = fso.OpenTextFile("T:\ PRO\Sauvegarde\testFichierEfface\logs\" & LogFile_Date & ".txt",8)
OutPut.WriteLine "*************************************************************************************************"
OutPut.WriteLine "Nous sommes Le " &  Day(Now) & "/" & Month(Now) & "/" & Year(Now)& " La liste des Fichiers Supprimés a cette heure " & Time & " est :" 
OutPut.WriteLine "*************************************************************************************************"
end if
'On verifie que le repertoire de sauvegarde existe 
If (myName = Winrep = fso.FolderExists(DossierSauvegarde)) = False Then 
    Erreur = MsgBox("Le dossier de sauvegarde est introuvable !" ) 
    Wscript.Quit 
End If 
 
 'On apelle la fonction d'effacement 
Clean(DossierSauvegarde) 
 
'Fonction d'effacement des fichiers 
Sub Clean(FolderPath) 
 Set Folder = fso.Getfolder(FolderPath) 
 
'On appelle récursivement la fonction s'il y a des sous dossiers 
 Set SubFolder = Folder.SubFolders 
   For Each CurrentFolder in SubFolder 
    If CurrentFolder.Size = 0 Then
     OutPut.WriteLine CurrentFolder.Path & " (Dossier vide)"
     NbDossiersEffaces = NbDossiersEffaces + 1
      If Err.Number = 70 Then ' Si permission refusée
         OutPut.WriteLine CurrentFolder.Path & " (Permission de suppression refusee)"
     End If
   End If
      Clean CurrentFolder.Path 
   Next 
 
'On efface les fichiers dans le dossier courant 
For Each File In Folder.Files 
 If (DateDiff("d", File.DateLastModified, dtmDateModifie) > CInt(AgeMaximalFichiers)) Then 
      'On verifie qu'ils ne sont pas en lecture seule 
      If File.Attributes And 1 Then File.Attributes = File.Attributes - 1 
	OutPut.WriteLine File.Path 
            File.Delete() 
            NbFichiersEffaces = NbFichiersEffaces + 1 
        End If 
Next 
End Sub
 
 'On efface les dossiers et sous-dossiers vides
 Const pfad = ("T:\ PRO\Sauvegarde\testFichierEfface")
 
Dim Text, Title, index, Txt()
Dim fso, wsh, i
index = 1
Set wsh = WScript.CreateObject ("WScript.Shell")
Set fso = WScript.CreateObject("Scripting.FileSystemObject") 
RecFolder index, wsh.ExpandEnvironmentStrings(pfad) 
Function RecFolder (idx, pfad) 
Dim fo, fc, i, colFiles, file 
 
Set fo = fso.GetFolder(pfad) 
Set fc = fo.SubFolders
Set colFiles = fo.Files
 
For Each i in fc 
Call RecFolder (idx+1, pfad + "\" + i.name) 
 
If i.Files.Count = 0 And i.SubFolders.Count = 0 Then 
fso.DeleteFolder(pfad + "\" + i.name)
End if
Next
End function
 
OutPut.WriteLine Cstr(NbFichiersEffaces) + " Fichiers ont ete Supprimes !" + " et " + Cstr(NbDossiersEffaces) + " Dossiers ont ete Supprimes !" 
OutPut.WriteLine "*************************************************************************************************"
MsgBox (Cstr(NbFichiersEffaces) + " fichiers ont ete effaces" + " et " + Cstr(NbDossiersEffaces) + " Dossiers ont ete Supprimes !" )

J’ai réussi seulement à faire un copier coller d’un fichier et de le mettre en zip sauf que lorsque je veux l’ouvrir, il s’ouvre pas :

Code:

1
2
3
4
5
6
7
dim filesys
set filesys=CreateObject("Scripting.FileSystemObject") 
 
 
If filesys.FileExists("T:\PRO\Sauvegarde\testFichierEfface\LEVEL.txt") Then 
filesys.CopyFile "T:\PRO\Sauvegarde\testFichierEfface\LEVEL.txt", "T: \PRO\Sauvegarde\testFichierEfface\archive\LEVEL.zip" 
End If

:salut:
Peut-être une piste en utilisant la commande XCopy.exe avec le commutateur /D:j-m-a

Citation:

/D:j-m-a ===> Copie les fichiers modifiés à partir de la date spécifiée. Si aucune date n'est donnée, copie uniquement les fichiers dont l'heure source est plus récente que l'heure de destination. Utile pour les sauvegardes.

Vous pouvez facilement modifier ce script au niveau de la variable Param :king:

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
Option Explicit
Dim sSrc,sDest,MyCmd,Temp,Titre,MsgTitre,MsgAttente,Copyright,oExec,ws,LogTmpFile,LogFile,MyExcludeFile,Param
Copyright = "[ XcopyScript © Hackoo Crackoo © 2014 ]"
Set ws = CreateObject("WScript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
sSrc = "C:\Downloads"
sDest = "E:\XCopytest"
LogTmpFile = "MyTmpXCopyLog.txt"
LogFile = "MyXCopyLog.txt"
Param = " /D /Y /E /F"
MyCmd = "XCopy" & " " & DblQuote(sSrc) & " " & DblQuote(sDest) & " " & Param &" > " & LogTmpFile &_
" & cmd /U /C Type " & LogTmpFile & " > " & LogFile & " & Del " & LogTmpFile & ""
Titre = "Copie de Sauvegarde " & Copyright
MsgAttente = "Copie de Sauvegarde : <font color=Yellow>" & DblQuote(sSrc) & " vers " & DblQuote(sDest) & " </font>  . . . ."
Call CreateProgressBar(Titre,MsgAttente)
Call LancerProgressBar()
Call Pause(2)
Call Executer(MyCmd,0)
Call FermerProgressBar()
ws.run LogFile
'****************************************************************************************************
 Function Executer(StrCmd,Console)
    Dim ws,MyCmd,Resultat
    Set ws = CreateObject("wscript.Shell")
'La valeur 0 pour cacher la console MS-DOS
    If Console = 0 Then
        MyCmd = "CMD /C " & StrCmd & " "
        Resultat = ws.run(MyCmd,Console,True)
        If Resultat = 0 Then
        Else
            MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
        End If
    End If
'La valeur 1 pour montrer la console MS-DOS
    If Console = 1 Then
        MyCmd = "CMD /K " & StrCmd & " "
        Resultat = ws.run(MyCmd,Console,False)
        If Resultat = 0 Then
        Else
            MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
        End If
    End If
    Executer = Resultat
End Function
'****************************************************************************************************
Sub CreateProgressBar(Titre,MsgAttente)
    Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
    Set ws = CreateObject("wscript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Temp = WS.ExpandEnvironmentStrings("%Temp%")
    PathOutPutHTML = Temp & "\Barre.hta"
    Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
    fhta.WriteLine "<HTML>"
    fhta.WriteLine "<HEAD>"
    fhta.WriteLine "<Title>  " & Titre & "</Title>"
    fhta.WriteLine "<HTA:APPLICATION"
    fhta.WriteLine "ICON = ""magnify.exe"" "
    fhta.WriteLine "BORDER=""THIN"" "
    fhta.WriteLine "INNERBORDER=""NO"" "
    fhta.WriteLine "MAXIMIZEBUTTON=""NO"" "
    fhta.WriteLine "MINIMIZEBUTTON=""NO"" "
    fhta.WriteLine "SCROLL=""NO"" "
    fhta.WriteLine "SYSMENU=""NO"" "
    fhta.WriteLine "SELECTION=""NO"" "
    fhta.WriteLine "SINGLEINSTANCE=""YES"">"
    fhta.WriteLine "</HEAD>"
    fhta.WriteLine "<BODY text=""white""><CENTER><DIV><SPAN ID=""ProgressBar""></SPAN>"
    fhta.WriteLine "<span><marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & MsgAttente &"</font></marquee></span></DIV></CENTER></BODY></HTML>"
    fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> "
    fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")"
    fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")"
    fhta.WriteLine "Sub window_onload()"
    fhta.WriteLine "    CenterWindow 500,90"
    fhta.WriteLine "    Self.document.bgColor = ""DarkOrange"" "
    fhta.WriteLine " End Sub"
    fhta.WriteLine " Sub CenterWindow(x,y)"
    fhta.WriteLine "    Dim iLeft,itop"
    fhta.WriteLine "    window.resizeTo x,y"
    fhta.WriteLine "    iLeft = window.screen.availWidth/2 - x/2"
    fhta.WriteLine "    itop = window.screen.availHeight/2 - y/2"
    fhta.WriteLine "    window.moveTo ileft,itop"
    fhta.WriteLine "End Sub"
    fhta.WriteLine "</script>"
    fhta.close
End Sub
'**********************************************************************************************
Sub LancerProgressBar()
    Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
End Sub
'**********************************************************************************************
Sub FermerProgressBar()
    oExec.Terminate
End Sub
'**********************************************************************************************
Sub Pause(NSeconds)
    Wscript.Sleep(NSeconds*1000)
End Sub  
'**********************************************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************

30/05/2014, 10h45
01Please

:D WAW merciiiii beaucoup :) ça fonctionne mais il reste quelques petits détails à rajouter, surement un if pour sélectionner les fichiers les plus récents, il faudrait également parcourir les sous dossiers et pour finir ça sera bien de compresser les fichiers copiés (je n'ai aucune idée de comment faire) pour gagner plus d'espace sur le disque dur :)
30/05/2014, 11h05
hackoofr

Citation:

Envoyé par 01Please

ça sera bien de compresser les fichiers copiés (je n'ai aucune idée de comment faire) pour gagner plus d'espace sur le disque dur :)

Vous pouvez utiliser Compression(Source,Destination,Password) :king:
30/05/2014, 11h26
hackoofr

:salut:
Si vous combiner les deux scripts ensemble ça va résoudre votre problème, alors il faut faire des tests :mouarf:
Par contre si vous trouviez un petit problème, alors poster le code combiné et modifié et :tagcode:
@+
30/05/2014, 11h35
01Please

1 pièce(s) jointe(s)

Erreur code

Pièce jointe 147350
30/05/2014, 11h38
01Please

je n'ai pas changé grand choses pour l'instant c'est pourquoi je n'ai pas inséré mon code modifié au post ;) Mais j'aurais voulut savoir comment résoudre l'erreur de mon post précédente: comme définir cette variable? :)
30/05/2014, 11h46
hackoofr

Citation:

Envoyé par 01Please

je n'ai pas changé grand choses pour l'instant c'est pourquoi je n'ai pas inséré mon code modifié au post ;) Mais j'aurais voulut savoir comment résoudre l'erreur de mon post précédente: comme définir cette variable? :)

Bon, premièrement, ce n'est pas pratique de poster une image pour montrer le code ;)
il faut le poster en cliquant sur le bouton # de l'éditeur en haut et à droite il va vous insérer le tagcode comme celui là
[code] Coller votre source ici[ /code]

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
 
Option Explicit
Dim sSrc,sDest,MyCmd,Temp,Titre,MsgTitre,MsgAttente,Copyright,oExec,ws,LogTmpFile,LogFile,MyExcludeFile,Param
Copyright = "[ XcopyScript © Hackoo Crackoo © 2014 ]"
Set ws = CreateObject("WScript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
sSrc = "T:\PRO\Sauvegarde\testFichierEfface"
sDest = "T:\PRO\Sauvegarde\testFichierEfface\archive"
LogTmpFile = "MyTmpXCopyLog.txt"
LogFile = "MyXCopyLog.txt"
Param = " /D /Y /E /F"
MyCmd = "XCopy" & " " & DblQuote(sSrc) & " " & DblQuote(sDest) & " " & Param &" > " & LogTmpFile &_
" & cmd /U /C Type " & LogTmpFile & " > " & LogFile & " & Del " & LogTmpFile & ""
Titre = "Copie de Sauvegarde " & Copyright
MsgAttente = "Copie de Sauvegarde : <font color=Yellow>" & DblQuote(sSrc) & " vers " & DblQuote(sDest) & " </font>  . . . ."
Call Compression(sSrc,sDest,"")'Sans Mot de passe
Call CreateProgressBar(Titre,MsgAttente)
Call LancerProgressBar()
Call Pause(2)
Call Executer(MyCmd,0)
Call FermerProgressBar()
ws.run LogFile
 
...

Quand j'appelle la fonction Call Compression (...) Il me dit qu'elle n'est pas définit

Code:

1
2
3
4
5
6
7
8
9
10
11
12
 
Destination = "T:\PRO\Sauvegarde\testFichierEfface\archive" & "\" & ExtensionType & ".zip" 'Nom de l'archive normale sans protection par mot de passe
'Protected_Destination = MyDoc & "\" & ExtensionType & "_Protected.zip" 'Nom de l'archive protégé par mot de passe
'Password = "123456" 'Changer juste cette variable pour choisir un autre mot de passe pour l'archive
Call CreateFolder(ExtensionType)
Set dc  = fso.Drives
For Each d in dc
	If d.IsReady Then
		racine = d.Driveletter & ":"
		GetResults racine,ExtensionType
	End If
Next

Dans ce code que je devrais rajouter, j'ai remplacé .rar par .zip car il me disait "Erreur: Impossible de trouver Winrar.EXE

Est ce possible de le modifier par .zip car j'ai testé mais cela ne fonctionne pas

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
Option Explicit
Dim fso,ws,d,bf,dc,racine,ExtensionType,Password,Destination, MyDoc
'Protected_Destination, 
Dim arrResult,sDrv,sFName,sFile,Source,Destination
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("Wscript.Shell")
MyDoc=ws.SpecialFolders("MyDocuments")'Dossier Mes Documents
Set bf = fso.GetFolder(MyDoc)
ExtensionType  = "JPG"
Source = "T:\PRO\Sauvegarde\testFichierEfface"
Destination = "T:\PRO\Sauvegarde\testFichierEfface\archive" & "\" & ExtensionType & ".zip" 'Nom de l'archive normale sans protection par mot de passe
'Protected_Destination = MyDoc & "\" & ExtensionType & "_Protected.zip" 'Nom de l'archive protégé par mot de passe
'Password = "123456" 'Changer juste cette variable pour choisir un autre mot de passe pour l'archive
Call CreateFolder(ExtensionType)
Set dc  = fso.Drives
For Each d in dc
	If d.IsReady Then
		racine = d.Driveletter & ":"
		GetResults racine,ExtensionType
	End If
Next
Call Compression(Source,Destination,"")'Sans Mot de passe
'Call Compression(Source,Protected_Destination,Password)'L'archive est protégé par un mot de passe
'**********************************************************************************
Sub GetResults(drv,fname)
	On Error Resume Next
	Dim sWQL,oFile,Results
	sWQL     = "select * from cim_datafile where Drive='" & _
	drv & "' AND Extension = '" & fname & "'"
	For Each oFile In GetObject("winmgmts:").execquery(sWQL)
		sFile   = oFile.Name
		CopyFile sFile,ExtensionType
	Next
End Sub
'**********************************************************************************
Sub CreateFolder(name)
	Set fso    = CreateObject("Scripting.FileSystemObject")
	If Not FSO.FolderExists(bf & "\" & name) Then
		bf.subFolders.Add(name)
		Else : Exit Sub
	End If
End Sub
'**********************************************************************************
Function CopyFile(sFile,name)
	Dim  fso,ws,bf
	'MyDoc
	Set FSO = CreateObject("Scripting.FileSystemObject")
	Set ws = CreateObject("Wscript.Shell")
	'MyDoc = ws.SpecialFolders("MyDocuments")'Dossier Mes Documents
	'Set bf = fso.GetFolder(MyDoc)
	If FSO.FolderExists(bf & "\" & name) Then
		FSO.GetFile(sFile).Copy bf & "\" & name & "\" & FSO.GetFileName(sFile),True
	Else
		MsgBox "erreur du chemin",16,"erreur du chemin"
	End If
End Function
'**********************************************************************************
Function Compression(Source,Destination,Password)
	Dim oFSO,oShell,aScriptFilename,sScriptFilename
	Dim sWorkingDirectory,ProgramFiles,sWinZipLocation
	Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
	Set oShell = WScript.CreateObject("Wscript.Shell")
'--------Trouver le répertoire de travail--------
	aScriptFilename = Split(Wscript.ScriptFullName, "\")
	sScriptFilename = aScriptFileName(Ubound(aScriptFilename))
	sWorkingDirectory = Replace(Wscript.ScriptFullName, sScriptFilename, "")
'--------------------------------------
	ProgramFiles = oShell.ExpandEnvironmentStrings("%ProgramFiles%")
'-------S'assurer que nous pouvons trouver WinRAR.exe------
	If oFSO.FileExists(sWorkingDirectory & " " & "Winrar.EXE") Then
		sWinZipLocation = ""
	ElseIf oFSO.FileExists(ProgramFiles &"\Winrar\Winrar.EXE") Then
		sWinZipLocation = ProgramFiles &"\Winrar\"
	Else
		Compression = "Erreur: Impossible de trouver Winrar.EXE"
		MsgBox Compression,16,Compression
		Exit Function
	End If
'--------------------------------------
'La Commande A : Signifie ==> ajouter à une archive
'Le Commutateur -IBCK ==> Signifie : Lancer WinRAR en arrière-plan
	If Password = "" Then
		oShell.Run """" & sWinZipLocation & "winrar.exe"" A -IBCK """ & _
		Destination & """ """ & Source & """",0,True 
	Else
'Le Commutateur -P<mot_de_passe> : Pour utiliser un mot de passe
		oShell.Run """" & sWinZipLocation & "winrar.exe"" A -IBCK -p"&Password&" """ & _
		Destination & """ """ & Source & """",0,True 
	End If
	If oFSO.FileExists(Destination) Then
		Compression = 1
	Else
		Compression = "Erreur : Création d'archives a échoué !"
		MsgBox Compression,16,Compression
	End If
End Function

L'erreur ligne 4 : redéfinition du nom... :/

Salut

Citation:

erreur ligne 4 : redéfinition du nom.
Code:

1 2 3 4 Option Explicit Dim fso,ws,d,bf,dc,racine,ExtensionType,Password,Destination, MyDoc 'Protected_Destination, Dim arrResult,sDrv,sFName,sFile,Source,Destination
Destination est déclaré 2 fois, ligne 2 et ligne 4

30/05/2014, 13h04
01Please

Ah oui XD c'est bien vrai ça :/ Merci ^^

Les liens m'ont été utile mais j'ai toujours des problèmes ...

dans ce code pour la compression des fichiers ->

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
Option Explicit
Dim source,Dest,MyCmd,Temp,Titre,MsgTitre,MsgAttente,Copyright,oExec,ws,LogTmpFile,LogFile,MyExcludeFile,Param
Dim ExtensionType, fso
Copyright = "[ XcopyScript © Hackoo Crackoo © 2014 ]"
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("WScript.Shell")
Set bf = fso.GetFolder(MyDoc)
Temp = ws.ExpandEnvironmentStrings("%Temp%")
ExtensionType  = "JPG"
source = "T:\PRO\Sauvegarde\testCompress"
Dest = "T:\PRO\Sauvegarde\testCompress\archive"
LogTmpFile = "TmpXCopyLog.txt"
LogFile = "MyXCopyLog.txt"
Param = " /D "
MyCmd = "XCopy" & " " & DblQuote(source) & " " & DblQuote(Dest) & " " & Param &" > " & LogTmpFile &_
" & cmd /U /C Type " & LogTmpFile & " > " & LogFile & " & Del " & LogTmpFile & ""
Titre = "Copie de Sauvegarde " & Copyright
MsgAttente = "Copie de Sauvegarde : <font color=Yellow>" & DblQuote(source) & " vers " & DblQuote(Dest) & " </font>  . . . ."
Call CreateProgressBar(Titre,MsgAttente)
Call LancerProgressBar()
Call Pause(2)
Call Executer(MyCmd,0)
Call FermerProgressBar()
Call CreateFolder(ExtensionType)
Set dc  = fso.Drives
For Each d in dc
	If d.IsReady Then
		racine = d.Driveletter & ":"
		GetResults racine,ExtensionType
	End If
Next
Call Compression(source,Dest,"")'Sans Mot de passe
ws.run LogFile
'****************************************************************************************************
 Function Executer(StrCmd,Console)
    Dim ws,MyCmd,Resultat
    Set ws = CreateObject("wscript.Shell")
'La valeur 0 pour cacher la console MS-DOS
    If Console = 0 Then
        MyCmd = "CMD /C " & StrCmd & " "
        Resultat = ws.run(MyCmd,Console,True)
        If Resultat = 0 Then
        Else
            MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
        End If
    End If
'La valeur 1 pour montrer la console MS-DOS
    If Console = 1 Then
        MyCmd = "CMD /K " & StrCmd & " "
        Resultat = ws.run(MyCmd,Console,False)
        If Resultat = 0 Then
        Else
            MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
        End If
    End If
    Executer = Resultat
End Function
'****************************************************************************************************
Sub CreateProgressBar(Titre,MsgAttente)
    Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
    Set ws = CreateObject("wscript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Temp = WS.ExpandEnvironmentStrings("%Temp%")
    PathOutPutHTML = Temp & "\Barre.hta"
    Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
    fhta.WriteLine "<HTML>"
    fhta.WriteLine "<HEAD>"
    fhta.WriteLine "<Title>  " & Titre & "</Title>"
    fhta.WriteLine "<HTA:APPLICATION"
    fhta.WriteLine "ICON = ""magnify.exe"" "
    fhta.WriteLine "BORDER=""THIN"" "
    fhta.WriteLine "INNERBORDER=""NO"" "
    fhta.WriteLine "MAXIMIZEBUTTON=""NO"" "
    fhta.WriteLine "MINIMIZEBUTTON=""NO"" "
    fhta.WriteLine "SCROLL=""NO"" "
    fhta.WriteLine "SYSMENU=""NO"" "
    fhta.WriteLine "SELECTION=""NO"" "
    fhta.WriteLine "SINGLEINSTANCE=""YES"">"
    fhta.WriteLine "</HEAD>"
    fhta.WriteLine "<BODY text=""white""><CENTER><DIV><SPAN ID=""ProgressBar""></SPAN>"
    fhta.WriteLine "<span><marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & MsgAttente &"</font></marquee></span></DIV></CENTER></BODY></HTML>"
    fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> "
    fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")"
    fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")"
    fhta.WriteLine "Sub window_onload()"
    fhta.WriteLine "    CenterWindow 500,90"
    fhta.WriteLine "    Self.document.bgColor = ""DarkOrange"" "
    fhta.WriteLine " End Sub"
    fhta.WriteLine " Sub CenterWindow(x,y)"
    fhta.WriteLine "    Dim iLeft,itop"
    fhta.WriteLine "    window.resizeTo x,y"
    fhta.WriteLine "    iLeft = window.screen.availWidth/2 - x/2"
    fhta.WriteLine "    itop = window.screen.availHeight/2 - y/2"
    fhta.WriteLine "    window.moveTo ileft,itop"
    fhta.WriteLine "End Sub"
    fhta.WriteLine "</script>"
    fhta.close
End Sub
'**********************************************************************************************
Sub LancerProgressBar()
    Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
End Sub
'**********************************************************************************************
Sub FermerProgressBar()
    oExec.Terminate
End Sub
'**********************************************************************************************
Sub Pause(NSeconds)
    Wscript.Sleep(NSeconds*1000)
End Sub  
'**********************************************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
'**********************************************************************************
Sub GetResults(drv,fname)
	On Error Resume Next 
	Dim sWQL,oFile,Results
	sWQL     = "select * from cim_datafile where Drive='" & _
	drv & "' AND Extension = '" & fname & "'"
	For Each oFile In GetObject("winmgmts:").execquery(sWQL)
		sFile   = oFile.Name
		CopyFile sFile,ExtensionType
	Next
End Sub
'**********************************************************************************
Sub CreateFolder(name)
	Set fso    = CreateObject("Scripting.FileSystemObject")
	If Not FSO.FolderExists(bf & "\" & name) Then
		bf.subFolders.Add(name)
		Else : Exit Sub
	End If
End Sub
'**********************************************************************************
Function CopyFile(sFile,name)
	Dim  fso,ws,bf, MyDoc
	Set FSO = CreateObject("Scripting.FileSystemObject")
	Set ws = CreateObject("Wscript.Shell")
	MyDoc = "T:\PRO\Sauvegarde\testFichierEfface"
	Set bf = fso.GetFolder(MyDoc)
	If FSO.FolderExists(bf & "\" & name) Then
		FSO.GetFile(sFile).Copy bf & "\" & name & "\" & FSO.GetFileName(sFile),True
	Else
		MsgBox "erreur du chemin",16,"erreur du chemin"
	End If
End Function
'**********************************************************************************
Function Compression(source,Dest,Password)
	Dim oFSO,oShell,aScriptFilename,sScriptFilename
	Dim sWorkingDirectory,ProgramFiles,sWinZipLocation
	Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
	Set oShell = WScript.CreateObject("Wscript.Shell")
'--------Trouver le répertoire de travail--------
	aScriptFilename = Split(Wscript.ScriptFullName, "\")
	sScriptFilename = aScriptFileName(Ubound(aScriptFilename))
	sWorkingDirectory = Replace(Wscript.ScriptFullName, sScriptFilename, "")
'--------------------------------------
	ProgramFiles = oShell.ExpandEnvironmentStrings("%ProgramFiles%")
'-------S'assurer que nous pouvons trouver WinRAR.exe------
	If oFSO.FileExists(sWorkingDirectory & " " & "7zFM.exe") Then
		sWinZipLocation = ""
	ElseIf oFSO.FileExists(ProgramFiles &"\7-Zip\7zFM.exe") Then
		sWinZipLocation = ProgramFiles &"\7-Zip\"
	Else
		Compression = "Erreur: Impossible de trouver 7zFM.exe"
		MsgBox Compression,16,Compression
		Exit Function
	End If
'--------------------------------------
'La Commande A : Signifie ==> ajouter à une archive
'Le Commutateur -IBCK ==> Signifie : Lancer WinRAR en arrière-plan
	If Password = "" Then
		oShell.Run """" & sWinZipLocation & "7zFM.exe"" A -IBCK """ & _
		Dest & """ """ & source & """",0,True 
	Else
'Le Commutateur -P<mot_de_passe> : Pour utiliser un mot de passe
		oShell.Run """" & sWinZipLocation & "7zFM.exe"" A -IBCK -p"&Password&" """ & _
		Dest & """ """ & source & """",0,True 
	End If
	If oFSO.FileExists(Dest) Then
		Compression = 1
	Else
		Compression = "Erreur : Création d'archives a échoué !"
		MsgBox Compression,16,Compression
	End If
End Function

J'aurais voulu savoir à quoi correspond ces lignes :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
MyDoc=ws.SpecialFolders("MyDocuments")'Dossier Mes Documents
Set bf = fso.GetFolder(MyDoc)
ExtensionType  = "JPG"
'...
Set dc  = fso.Drives
For Each d in dc
	If d.IsReady Then
		racine = d.Driveletter & ":"
		GetResults racine,ExtensionType
	End If
Next
'...

:salut:
Voici un script modifié et testé chez moi qui marche 5/5 :mouarf: :king:
Remarque : vous deviez choisir le dossier "E:\archive" et non pas "E:\Pro\Sauvegarde\testFichierEfface\archive" sinon vous tombiez dans l'erreur de copie cyclique.
et aussi il faut que Winrar soit installé sur votre machine

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
Option Explicit
Dim sSrc,sDest,MyCmd,Temp,Titre,MsgTitre,MsgAttente,Source,Destination
Dim Copyright,oExec,ws,LogTmpFile,LogFile,MyExcludeFile,Param
Copyright = "[ XcopyScript © Hackoo Crackoo © 2014 ]"
Set ws = CreateObject("WScript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
sSrc = "E:\Pro\Sauvegarde\testFichierEfface"
sDest = "E:\archive"
LogTmpFile = "MyTmpXCopyLog.txt"
LogFile = "MyXCopyLog.txt"
Param = " /D /Y /E /F"
MyCmd = "XCopy" & " " & DblQuote(sSrc) & " " & DblQuote(sDest) & " " & Param &" > " & LogTmpFile &_
" & cmd /U /C Type " & LogTmpFile & " > " & LogFile & " & Del " & LogTmpFile & ""
Titre = "Copie de Sauvegarde " & Copyright
MsgAttente = "Copie de Sauvegarde : <font color=Yellow>" & DblQuote(sSrc) & " vers " & DblQuote(sDest) & " </font>  . . . ."
Call CreateProgressBar(Titre,MsgAttente)
Call LancerProgressBar()
Call Pause(2)
Call Executer(MyCmd,0,True)
'Maintenant on définie les varaiables Source et Destination pour archiver la source avec Winrar vers la destination
Source = sSrc
Destination = sDest &".rar"
Call Compression(Source,Destination,"")' Compression sans mot de passe
Call FermerProgressBar()
ws.run LogFile
'**************************************************************************************************************
Function Executer(StrCmd,Console,bWaitOnReturn)
   Dim ws,MyCmd,Resultat
   Set ws = CreateObject("wscript.Shell")
'La valeur 0 pour cacher la console MS-DOS
   If Console = 0 Then
      MyCmd = "CMD /C " & StrCmd & ""
      Resultat = ws.run(MyCmd,Console,bWaitOnReturn)
      If Resultat = 0 Then
      Else
         MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
      End If
   End If
'La valeur 1 pour montrer la console MS-DOS
   If Console = 1 Then
      MyCmd = "CMD /K " & StrCmd & " "
      Resultat = ws.run(MyCmd,Console,bWaitOnReturn)
      If Resultat = 0 Then
      Else
         MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
      End If
   End If
   Executer = Resultat
End Function
'***********************************************************************************************************
Function Compression(Source,Destination,Password)
    Dim oFSO,oShell,aScriptFilename,sScriptFilename
    Dim sWorkingDirectory,ProgramFiles,sWinZipLocation
    Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
    Set oShell = WScript.CreateObject("Wscript.Shell")
'--------Trouver le répertoire de travail--------
    aScriptFilename = Split(Wscript.ScriptFullName, "\")
    sScriptFilename = aScriptFileName(Ubound(aScriptFilename))
    sWorkingDirectory = Replace(Wscript.ScriptFullName, sScriptFilename, "")
'--------------------------------------
    ProgramFiles = oShell.ExpandEnvironmentStrings("%ProgramFiles%")
'-------S'assurer que nous pouvons trouver WinRAR.exe------
    If oFSO.FileExists(sWorkingDirectory & " " & "Winrar.EXE") Then
        sWinZipLocation = ""
    ElseIf oFSO.FileExists(ProgramFiles &"\Winrar\Winrar.EXE") Then
        sWinZipLocation = ProgramFiles &"\Winrar\"
    Else
        Compression = "Erreur: Impossible de trouver Winrar.EXE"
        MsgBox Compression,16,Compression
        Exit Function
    End If
'--------------------------------------
'La Commande A : Signifie ==> ajouter à une archive
'Le Commutateur -IBCK ==> Signifie : Lancer WinRAR en arrière-plan
    If Password = "" Then
        oShell.Run """" & sWinZipLocation & "winrar.exe"" A -IBCK """ & _
        Destination & """ """ & Source & """",0,True 
    Else
'Le Commutateur -P<mot_de_passe> : Pour utiliser un mot de passe
        oShell.Run """" & sWinZipLocation & "winrar.exe"" A -IBCK -p"&Password&" """ & _
        Destination & """ """ & Source & """",0,True 
    End If
    If oFSO.FileExists(Destination) Then
        Compression = 1
    Else
        Compression = "Erreur : Création d'archives a échoué !"
        MsgBox Compression,16,Compression
    End If
End Function
'***********************************************************************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(strIn)
   DblQuote = Chr(34) & strIn & Chr(34)
End Function
'***********************************************************************************************************
Sub CreateProgressBar(Titre,MsgAttente)
    Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
    Set ws = CreateObject("wscript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Temp = WS.ExpandEnvironmentStrings("%Temp%")
    PathOutPutHTML = Temp & "\Barre.hta"
    Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
    fhta.WriteLine "<HTML>"
    fhta.WriteLine "<HEAD>"
    fhta.WriteLine "<Title>  " & Titre & "</Title>"
    fhta.WriteLine "<HTA:APPLICATION"
    fhta.WriteLine "ICON = ""magnify.exe"" "
    fhta.WriteLine "BORDER=""THIN"" "
    fhta.WriteLine "INNERBORDER=""NO"" "
    fhta.WriteLine "MAXIMIZEBUTTON=""NO"" "
    fhta.WriteLine "MINIMIZEBUTTON=""NO"" "
    fhta.WriteLine "SCROLL=""NO"" "
    fhta.WriteLine "SYSMENU=""NO"" "
    fhta.WriteLine "SELECTION=""NO"" "
    fhta.WriteLine "SINGLEINSTANCE=""YES"">"
    fhta.WriteLine "</HEAD>"
    fhta.WriteLine "<BODY text=""white""><CENTER><DIV><SPAN ID=""ProgressBar""></SPAN>"
    fhta.WriteLine "<span><marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & MsgAttente &"</font></marquee></span></DIV></CENTER></BODY></HTML>"
    fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> "
    fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")"
    fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")"
    fhta.WriteLine "Sub window_onload()"
    fhta.WriteLine "    CenterWindow 500,90"
    fhta.WriteLine "    Self.document.bgColor = ""DarkOrange"" "
    fhta.WriteLine " End Sub"
    fhta.WriteLine " Sub CenterWindow(x,y)"
    fhta.WriteLine "    Dim iLeft,itop"
    fhta.WriteLine "    window.resizeTo x,y"
    fhta.WriteLine "    iLeft = window.screen.availWidth/2 - x/2"
    fhta.WriteLine "    itop = window.screen.availHeight/2 - y/2"
    fhta.WriteLine "    window.moveTo ileft,itop"
    fhta.WriteLine "End Sub"
    fhta.WriteLine "</script>"
    fhta.close
End Sub
'**********************************************************************************************
Sub LancerProgressBar()
    Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
End Sub
'**********************************************************************************************
Sub FermerProgressBar()
    oExec.Terminate
End Sub
'**********************************************************************************************
Sub Pause(NSeconds)
    Wscript.Sleep(NSeconds*1000)
End Sub  
'**********************************************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************

31/05/2014, 20h21
01Please

Fichier MyTmpXCopyLog

Merci encore pour votre aide si précieuse ^^, je m'excuse encore de vous poser encore d'autres questions ^^ (l'archive n'a pas fonctionné); pourquoi quand je lance le même programme il m'indique dans le fichier MyTmpXCopyLog :
Est-ce que C:\archive désigne un nom de fichier
ou un nom de répertoire de la destination
(F = fichier, R = répertoire)?
31/05/2014, 20h37
hackoofr

Citation:

Envoyé par 01Please

Merci encore pour votre aide si précieuse ^^, je m'excuse encore de vous poser encore d'autres questions ^^ (l'archive n'a pas fonctionné); pourquoi quand je lance le même programme il m'indique dans le fichier MyTmpXCopyLog :
Est-ce que C:\archive d‚signe un nom de fichier
ou un nom de r‚pertoire de la destination
(F = fichier, R = répertoire)?

:salut:
Postez votre modification et :tagcode:
31/05/2014, 20h51
01Please
J'ai changé de chemin, vu que j'ai changé de PC mais le chemin est juste.
Code:

1 2 3 sSrc = "C:\Users\falun_000\Documents\TEST" sDest = "C:\ARCHIVE"
Pour les paramètres, j'ai gardé seulement l'option D

Code:

Param = " /D "

De plus j'ai un problème, quand j’exécute le programme en plus du fichier texte qui apparait dans le log. J'ai une fenêtre de Winrar qui me dit Impossible de créer C:\ARCHIVE.rar cela vient-il de cette ligne :

Code:

Destination = sDest &".rar"
31/05/2014, 21h20
hackoofr

Le dossier C:\ARCHIVE existe ou non :koi:
01/06/2014, 11h07
01Please

Le vrai chemin est "C:\Users\falun_000\Documents\TEST\ARCHIVE"

Mais vous m'avez dit de mettre C:\ARCHIVE pour éviter l'erreur de copie cyclique. ... n'est ce pas ?

:salut:
Voici un script plus général qui vous permet de parcourir un dossier à copier dans un dossier qui se crée automatiquement via le script avec un nom générique avec la date du jour, comme par exemple "Archive_1_6_2014" puis il se compresse sous le nom de Archive_1_6_2014.rar et ceci dans votre dossier documents
Donc à tester et sans changer aucune ligne dans le code car celui-ci va prendre tout en charge :king:

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
Option Explicit
Dim sSrc,sDest,MyCmd,Temp,Titre,MsgTitre,MsgAttente,Source,Destination,bf
Dim Copyright,oExec,ws,LogTmpFile,LogFile,Param,Archive,MyDoc,fso
Copyright = "[ XcopyScript © Hackoo Crackoo © 2014 ]"
Set ws = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
sSrc = Parcourir_Dossier()
MyDoc = ws.SpecialFolders("MyDocuments")'Dossier Mes Documents
Set bf = fso.GetFolder(MyDoc)
Archive  = "Archive_"& Day(Now) & "_" & Month(Now) & "_" & Year(Now)
sDest = MyDoc & "\" & Archive
Call CreateFolder(bf,Archive)
LogTmpFile = "MyTmpXCopyLog.txt"
LogFile = "MyXCopyLog.txt"
Param = " /D"
MyCmd = "XCopy" & " " & DblQuote(sSrc) & " " & DblQuote(sDest) & " " & Param &" > " & LogTmpFile &_
" & cmd /U /C Type " & LogTmpFile & " > " & LogFile & " & Del " & LogTmpFile & ""
Titre = "Copie de Sauvegarde " & Copyright
MsgAttente = "Copie de Sauvegarde : <font color=Yellow>" & DblQuote(sSrc) & " vers " & DblQuote(sDest) & " </font>  . . . ."
Call CreateProgressBar(Titre,MsgAttente)
Call LancerProgressBar()
Call Pause(2)
Call Executer(MyCmd,0,True)
'Maintenant on définie les varaiables Source et Destination pour archiver la source avec Winrar vers la destination
Source = sDest
Destination = sDest &".rar"
Call Compression(Source,Destination,"")' Compression sans mot de passe
Call FermerProgressBar()
ws.run LogFile
'****************************************************************************************************
Function Parcourir_Dossier()
    Dim objShell,objFolder
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0, "Veuillez choisir un dossier pour la Sauvegarde " & Copyright,1,"c:\Programs")
    If objFolder Is Nothing Then
        Wscript.Quit
    End If
    Parcourir_Dossier = objFolder.self.path
end Function
'**************************************************************************************************************
Sub CreateFolder(bf,name)
    Set fso  = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(bf & "\" & name) Then
        bf.subFolders.Add(name)
        Else : Exit Sub
    End If
End Sub
'**************************************************************************************************************
Function Executer(StrCmd,Console,bWaitOnReturn)
   Dim ws,MyCmd,Resultat
   Set ws = CreateObject("wscript.Shell")
'La valeur 0 pour cacher la console MS-DOS
   If Console = 0 Then
      MyCmd = "CMD /C " & StrCmd & ""
      Resultat = ws.run(MyCmd,Console,bWaitOnReturn)
      If Resultat = 0 Then
      Else
         MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
      End If
   End If
'La valeur 1 pour montrer la console MS-DOS
   If Console = 1 Then
      MyCmd = "CMD /K " & StrCmd & " "
      Resultat = ws.run(MyCmd,Console,bWaitOnReturn)
      If Resultat = 0 Then
      Else
         MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
      End If
   End If
   Executer = Resultat
End Function
'***********************************************************************************************************
Function Compression(Source,Destination,Password)
    Dim oFSO,oShell,aScriptFilename,sScriptFilename
    Dim sWorkingDirectory,ProgramFiles,sWinZipLocation
    Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
    Set oShell = WScript.CreateObject("Wscript.Shell")
'--------Trouver le répertoire de travail--------
    aScriptFilename = Split(Wscript.ScriptFullName, "\")
    sScriptFilename = aScriptFileName(Ubound(aScriptFilename))
    sWorkingDirectory = Replace(Wscript.ScriptFullName, sScriptFilename, "")
'--------------------------------------
    ProgramFiles = oShell.ExpandEnvironmentStrings("%ProgramFiles%")
'-------S'assurer que nous pouvons trouver WinRAR.exe------
    If oFSO.FileExists(sWorkingDirectory & " " & "Winrar.EXE") Then
        sWinZipLocation = ""
    ElseIf oFSO.FileExists(ProgramFiles &"\Winrar\Winrar.EXE") Then
        sWinZipLocation = ProgramFiles &"\Winrar\"
    Else
        Compression = "Erreur: Impossible de trouver Winrar.EXE"
        MsgBox Compression,16,Compression
        Exit Function
    End If
'--------------------------------------
'La Commande A : Signifie ==> ajouter à une archive
'Le Commutateur -IBCK ==> Signifie : Lancer WinRAR en arrière-plan
    If Password = "" Then
        oShell.Run """" & sWinZipLocation & "winrar.exe"" A -IBCK """ & _
        Destination & """ """ & Source & """",0,True 
    Else
'Le Commutateur -P<mot_de_passe> : Pour utiliser un mot de passe
        oShell.Run """" & sWinZipLocation & "winrar.exe"" A -IBCK -p"&Password&" """ & _
        Destination & """ """ & Source & """",0,True 
    End If
    If oFSO.FileExists(Destination) Then
        Compression = 1
    Else
        Compression = "Erreur : Création d'archives a échoué !"
        MsgBox Compression,16,Compression
    End If
End Function
'***********************************************************************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(strIn)
   DblQuote = Chr(34) & strIn & Chr(34)
End Function
'***********************************************************************************************************
Sub CreateProgressBar(Titre,MsgAttente)
    Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
    Set ws = CreateObject("wscript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Temp = WS.ExpandEnvironmentStrings("%Temp%")
    PathOutPutHTML = Temp & "\Barre.hta"
    Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
    fhta.WriteLine "<HTML>"
    fhta.WriteLine "<HEAD>"
    fhta.WriteLine "<Title>  " & Titre & "</Title>"
    fhta.WriteLine "<HTA:APPLICATION"
    fhta.WriteLine "ICON = ""magnify.exe"" "
    fhta.WriteLine "BORDER=""THIN"" "
    fhta.WriteLine "INNERBORDER=""NO"" "
    fhta.WriteLine "MAXIMIZEBUTTON=""NO"" "
    fhta.WriteLine "MINIMIZEBUTTON=""NO"" "
    fhta.WriteLine "SCROLL=""NO"" "
    fhta.WriteLine "SYSMENU=""NO"" "
    fhta.WriteLine "SELECTION=""NO"" "
    fhta.WriteLine "SINGLEINSTANCE=""YES"">"
    fhta.WriteLine "</HEAD>"
    fhta.WriteLine "<BODY text=""white""><CENTER><DIV><SPAN ID=""ProgressBar""></SPAN>"
    fhta.WriteLine "<span><marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & MsgAttente &"</font></marquee></span></DIV></CENTER></BODY></HTML>"
    fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> "
    fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")"
    fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")"
    fhta.WriteLine "Sub window_onload()"
    fhta.WriteLine "    CenterWindow 500,90"
    fhta.WriteLine "    Self.document.bgColor = ""DarkOrange"" "
    fhta.WriteLine " End Sub"
    fhta.WriteLine " Sub CenterWindow(x,y)"
    fhta.WriteLine "    Dim iLeft,itop"
    fhta.WriteLine "    window.resizeTo x,y"
    fhta.WriteLine "    iLeft = window.screen.availWidth/2 - x/2"
    fhta.WriteLine "    itop = window.screen.availHeight/2 - y/2"
    fhta.WriteLine "    window.moveTo ileft,itop"
    fhta.WriteLine "End Sub"
    fhta.WriteLine "</script>"
    fhta.close
End Sub
'**********************************************************************************************
Sub LancerProgressBar()
    Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
End Sub
'**********************************************************************************************
Sub FermerProgressBar()
    oExec.Terminate
End Sub
'**********************************************************************************************
Sub Pause(NSeconds)
    Wscript.Sleep(NSeconds*1000)
End Sub  
'**********************************************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************

:king: Merciiiiiiiii beaucoup :D , votre code fonctionne à merveille le seul petit détail qui manque c'est qui ne permet pas la copie des sous dossiers du dossier sélectionné, j'ai plusieurs sous dossiers (beaucoup trop pour faire la manipulation pour tous les sous-dossiers, j'ai donc voulu rajouter du code :

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
'Parcourir les sous-dossier
Dim index, wsh, i, objFolder
index = 1
Set wsh = WScript.CreateObject ("WScript.Shell")
Set fso = WScript.CreateObject("Scripting.FileSystemObject") 
RecFolder index, wsh.ExpandEnvironmentStrings(objFolder) 
Function RecFolder (idx, objFolder) 
Dim fo, fc, i, colFiles, file 
Set fo = fso.GetFolder(objFolder) 'Argument ou appel de procédure incorrect
'Set objFolder = fso.GetFolder(objFolder)
    If objFolder Is Nothing Then
        Wscript.Quit
    End If
    Parcourir_Dossier = objFolder.self.path
Set fc = fo.SubFolders
Set colFiles = fo.Files
For Each i in fc 
Call RecFolder (idx+1, objFolder + "\" + i.name) 
 
If i.Files.Count = 0 And i.SubFolders.Count = 0 Then 
fso.CopyFolder(objFolder + "\" + i.name) 'Commande fausse 
End if
Next
End function

J'ai essayé mais je tourne en rond :?

Code:

1 2 3 4 5 6 7 8 9 Sub SuperCreateFolder(fd) If fd="" Then exit sub bs=InstrRev(fd,"\") parent=left(fd,bs-1) If len(parent)>2 Then If not fso.FolderExists(parent) then SuperCreateFolder Parent End If fso.CreateFolder(fd) End Sub
J'ai essayé également ce bout de code mais il ne fonctionne pas non plus, le programme tourne en boucle ...

:salut:
Pas aussi compliqué :lol:

Citation:

/E : Copie les répertoires et sous-répertoires, y compris les répertoires vides.

Citation:

/Y : Supprime la demande de confirmation de remplacement de fichiers de destination existants.

Il suffit de changer cette ligne en ajoutant ces commutateurs :

Code:

Param = " /D"

par celle-ci

Code:

Param = " /D /Y /E"

:king: et le tour est joué :mouarf: :zoubi: :plusser:

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
Option Explicit
Dim sSrc,sDest,MyCmd,Temp,Titre,MsgTitre,MsgAttente,Source,Destination,bf
Dim Copyright,oExec,ws,LogTmpFile,LogFile,Param,Archive,MyDoc,fso
Copyright = "[ XcopyScript © Hackoo Crackoo © 2014 ]"
Set ws = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
sSrc = Parcourir_Dossier()
MyDoc = ws.SpecialFolders("MyDocuments")'Dossier Mes Documents
Set bf = fso.GetFolder(MyDoc)
Archive  = "Archive_"& Day(Now) & "_" & Month(Now) & "_" & Year(Now)
sDest = MyDoc & "\" & Archive
Call CreateFolder(bf,Archive)
LogTmpFile = "MyTmpXCopyLog.txt"
LogFile = "MyXCopyLog.txt"
Param = " /D /Y /E"
MyCmd = "XCopy" & " " & DblQuote(sSrc) & " " & DblQuote(sDest) & " " & Param &" > " & LogTmpFile &_
" & cmd /U /C Type " & LogTmpFile & " > " & LogFile & " & Del " & LogTmpFile & ""
Titre = "Copie de Sauvegarde " & Copyright
MsgAttente = "Copie de Sauvegarde : <font color=Yellow>" & DblQuote(sSrc) & " vers " & DblQuote(sDest) & " </font>  . . . ."
Call CreateProgressBar(Titre,MsgAttente)
Call LancerProgressBar()
Call Pause(2)
Call Executer(MyCmd,0,True)
'Maintenant on définie les varaiables Source et Destination pour archiver la source avec Winrar vers la destination
Source = sDest
Destination = sDest &".rar"
Call Compression(Source,Destination,"")' Compression sans mot de passe
Call FermerProgressBar()
ws.run LogFile
'****************************************************************************************************
Function Parcourir_Dossier()
    Dim objShell,objFolder
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0, "Veuillez choisir un dossier pour la Sauvegarde " & Copyright,1,"c:\Programs")
    If objFolder Is Nothing Then
        Wscript.Quit
    End If
    Parcourir_Dossier = objFolder.self.path
end Function
'**************************************************************************************************************
Sub CreateFolder(bf,name)
    Set fso  = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(bf & "\" & name) Then
        bf.subFolders.Add(name)
        Else : Exit Sub
    End If
End Sub
'**************************************************************************************************************
Function Executer(StrCmd,Console,bWaitOnReturn)
   Dim ws,MyCmd,Resultat
   Set ws = CreateObject("wscript.Shell")
'La valeur 0 pour cacher la console MS-DOS
   If Console = 0 Then
      MyCmd = "CMD /C " & StrCmd & ""
      Resultat = ws.run(MyCmd,Console,bWaitOnReturn)
      If Resultat = 0 Then
      Else
         MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
      End If
   End If
'La valeur 1 pour montrer la console MS-DOS
   If Console = 1 Then
      MyCmd = "CMD /K " & StrCmd & " "
      Resultat = ws.run(MyCmd,Console,bWaitOnReturn)
      If Resultat = 0 Then
      Else
         MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
      End If
   End If
   Executer = Resultat
End Function
'***********************************************************************************************************
Function Compression(Source,Destination,Password)
    Dim oFSO,oShell,aScriptFilename,sScriptFilename
    Dim sWorkingDirectory,ProgramFiles,sWinZipLocation
    Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
    Set oShell = WScript.CreateObject("Wscript.Shell")
'--------Trouver le répertoire de travail--------
    aScriptFilename = Split(Wscript.ScriptFullName, "\")
    sScriptFilename = aScriptFileName(Ubound(aScriptFilename))
    sWorkingDirectory = Replace(Wscript.ScriptFullName, sScriptFilename, "")
'--------------------------------------
    ProgramFiles = oShell.ExpandEnvironmentStrings("%ProgramFiles%")
'-------S'assurer que nous pouvons trouver WinRAR.exe------
    If oFSO.FileExists(sWorkingDirectory & " " & "Winrar.EXE") Then
        sWinZipLocation = ""
    ElseIf oFSO.FileExists(ProgramFiles &"\Winrar\Winrar.EXE") Then
        sWinZipLocation = ProgramFiles &"\Winrar\"
    Else
        Compression = "Erreur: Impossible de trouver Winrar.EXE"
        MsgBox Compression,16,Compression
        Exit Function
    End If
'--------------------------------------
'La Commande A : Signifie ==> ajouter à une archive
'Le Commutateur -IBCK ==> Signifie : Lancer WinRAR en arrière-plan
    If Password = "" Then
        oShell.Run """" & sWinZipLocation & "winrar.exe"" A -IBCK """ & _
        Destination & """ """ & Source & """",0,True 
    Else
'Le Commutateur -P<mot_de_passe> : Pour utiliser un mot de passe
        oShell.Run """" & sWinZipLocation & "winrar.exe"" A -IBCK -p"&Password&" """ & _
        Destination & """ """ & Source & """",0,True 
    End If
    If oFSO.FileExists(Destination) Then
        Compression = 1
    Else
        Compression = "Erreur : Création d'archives a échoué !"
        MsgBox Compression,16,Compression
    End If
End Function
'***********************************************************************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(strIn)
   DblQuote = Chr(34) & strIn & Chr(34)
End Function
'***********************************************************************************************************
Sub CreateProgressBar(Titre,MsgAttente)
    Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
    Set ws = CreateObject("wscript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Temp = WS.ExpandEnvironmentStrings("%Temp%")
    PathOutPutHTML = Temp & "\Barre.hta"
    Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
    fhta.WriteLine "<HTML>"
    fhta.WriteLine "<HEAD>"
    fhta.WriteLine "<Title>  " & Titre & "</Title>"
    fhta.WriteLine "<HTA:APPLICATION"
    fhta.WriteLine "ICON = ""magnify.exe"" "
    fhta.WriteLine "BORDER=""THIN"" "
    fhta.WriteLine "INNERBORDER=""NO"" "
    fhta.WriteLine "MAXIMIZEBUTTON=""NO"" "
    fhta.WriteLine "MINIMIZEBUTTON=""NO"" "
    fhta.WriteLine "SCROLL=""NO"" "
    fhta.WriteLine "SYSMENU=""NO"" "
    fhta.WriteLine "SELECTION=""NO"" "
    fhta.WriteLine "SINGLEINSTANCE=""YES"">"
    fhta.WriteLine "</HEAD>"
    fhta.WriteLine "<BODY text=""white""><CENTER><DIV><SPAN ID=""ProgressBar""></SPAN>"
    fhta.WriteLine "<span><marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & MsgAttente &"</font></marquee></span></DIV></CENTER></BODY></HTML>"
    fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> "
    fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")"
    fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")"
    fhta.WriteLine "Sub window_onload()"
    fhta.WriteLine "    CenterWindow 500,90"
    fhta.WriteLine "    Self.document.bgColor = ""DarkOrange"" "
    fhta.WriteLine " End Sub"
    fhta.WriteLine " Sub CenterWindow(x,y)"
    fhta.WriteLine "    Dim iLeft,itop"
    fhta.WriteLine "    window.resizeTo x,y"
    fhta.WriteLine "    iLeft = window.screen.availWidth/2 - x/2"
    fhta.WriteLine "    itop = window.screen.availHeight/2 - y/2"
    fhta.WriteLine "    window.moveTo ileft,itop"
    fhta.WriteLine "End Sub"
    fhta.WriteLine "</script>"
    fhta.close
End Sub
'**********************************************************************************************
Sub LancerProgressBar()
    Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
End Sub
'**********************************************************************************************
Sub FermerProgressBar()
    oExec.Terminate
End Sub
'**********************************************************************************************
Sub Pause(NSeconds)
    Wscript.Sleep(NSeconds*1000)
End Sub  
'**********************************************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************

02/06/2014, 10h51
01Please

De ce point de vue c'est beaucoup plus simple :king:
Par contre, le programme n'a rien crée (cela provient surement du commutateur /Y ) juste le dossier Archive_2-6-2014 et l'archive mais rien à l'intérieur, il indique comme précédemment dans le fichier log :
--> Remplacer C:\Documents\Archive_2_6_2014\scriptSuppressionLEVEL3(40jours).vbs (Oui/Non/Tous)?

Comment faire pour répondre tous automatiquement ? :)
02/06/2014, 11h00
01Please
Code:

1 2 3 Dim MaCmd MaCmd = "Tous" Call Executer(MaCmd,0)
Je dois exécuter ce code quand on me demande si le dossier où le fichier doit être remplacer où dois-je mettre ce code ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Option Explicit
Dim sSrc,sDest,MyCmd,Temp,Titre,MsgTitre,MsgAttente,Source,Destination,bf, MaCmd
...
 
MyCmd = "XCopy" & " " & DblQuote(sSrc) & " " & DblQuote(sDest) & " " & Param &" > " & LogTmpFile &_
" & cmd /U /C Type " & LogTmpFile & " > " & LogFile & " & Del " & LogTmpFile & ""
Titre = "Copie de Sauvegarde " 
MaCmd = "Tous"
MsgAttente = "Copie de Sauvegarde : <font color=Yellow>" & DblQuote(sSrc) & " vers " & DblQuote(sDest) & " </font>  . . . ."
Call CreateProgressBar(Titre,MsgAttente)
Call LancerProgressBar()
Call Pause(2)
Call Executer(MyCmd,0,True)
Call Execute(MaCMd,0, True)

:) J'ai rajouté MaCmd = "tous"

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
Function Executer(StrCmd,Console,bWaitOnReturn)
   Dim ws,MyCmd,Resultat
   Set ws = CreateObject("wscript.Shell")
'La valeur 0 pour cacher la console MS-DOS
   If Console = 0 Then
      MyCmd = "CMD /C " & StrCmd & ""
      Resultat = ws.run(MyCmd,Console,bWaitOnReturn)
      If Resultat = 0 Then
      Else
         MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
      End If
   End If
'La valeur 1 pour montrer la console MS-DOS
   If Console = 1 Then
      MyCmd = "CMD /K " & StrCmd & " "
      Resultat = ws.run(MyCmd,Console,bWaitOnReturn)
      If Resultat = 0 Then
      Else
         MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
      End If
   End If
   Executer = Resultat
End Function
'**********************************************************************************
Function Execute(StrCmd,Console,bWaitOnReturn)
   Dim ws,MaCmd,Resultat
   Set ws = CreateObject("wscript.Shell")
'La valeur 0 pour cacher la console MS-DOS
	If Console = 0 Then
      MaCmd = "CMD /C " & StrCmd & ""
      Resultat = ws.run(MaCmd,Console,bWaitOnReturn)
      If Resultat = 0 Then
      Else
         MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
      End If
   End If
   Execute = Resultat
End Function

Puis j'ai ensuite rajouté la fonction execute pour faire la différence entre la première commande DOS qui copie les fichiers et celle qui répond d'écraser tous les fichiers. Malheureusement ça ne fonctionne pas :'(

02/06/2014, 13h18
hackoofr

:salut:
Help de la commande Xcopy
Applications de Xcopy
Et poster votre code en entier

Apparemment vous avez un espace en plus
Copier et coller et ne modifie aucune ligne puis donner moi le résultat

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
Option Explicit
Dim sSrc,sDest,MyCmd,Temp,Titre,MsgTitre,MsgAttente,Source,Destination,bf
Dim Copyright,oExec,ws,LogTmpFile,LogFile,Param,Archive,MyDoc,fso
Copyright = "[ XcopyScript © Hackoo Crackoo © 2014 ]"
Set ws = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
sSrc = Parcourir_Dossier()
MyDoc = ws.SpecialFolders("MyDocuments")'Dossier Mes Documents
Set bf = fso.GetFolder(MyDoc)
Archive  = "Archive_"& Day(Now) & "_" & Month(Now) & "_" & Year(Now)
sDest = MyDoc & "\" & Archive
Call CreateFolder(bf,Archive)
LogTmpFile = "MyTmpXCopyLog.txt"
LogFile = "MyXCopyLog.txt"
Param = " /D /Y /E"
MyCmd = "XCopy" & " " & DblQuote(sSrc) & " " & DblQuote(sDest) & " " & Param &" > " & LogTmpFile &_
" & cmd /U /C Type " & LogTmpFile & " > " & LogFile & " & Del " & LogTmpFile & ""
Titre = "Copie de Sauvegarde " & Copyright
MsgAttente = "Copie de Sauvegarde : <font color=Yellow>" & DblQuote(sSrc) & " vers " & DblQuote(sDest) & " </font>  . . . ."
Call CreateProgressBar(Titre,MsgAttente)
Call LancerProgressBar()
Call Pause(2)
Call Executer(MyCmd,0,True)
'Maintenant on définie les varaiables Source et Destination pour archiver la source avec Winrar vers la destination
Source = sDest
Destination = sDest &".rar"
Call Compression(Source,Destination,"")' Compression sans mot de passe
Call FermerProgressBar()
ws.run LogFile
'****************************************************************************************************
Function Parcourir_Dossier()
    Dim objShell,objFolder
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0, "Veuillez choisir un dossier pour la Sauvegarde " & Copyright,1,"c:\Programs")
    If objFolder Is Nothing Then
        Wscript.Quit
    End If
    Parcourir_Dossier = objFolder.self.path
end Function
'**************************************************************************************************************
Sub CreateFolder(bf,name)
    Set fso  = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(bf & "\" & name) Then
        bf.subFolders.Add(name)
        Else : Exit Sub
    End If
End Sub
'**************************************************************************************************************
Function Executer(StrCmd,Console,bWaitOnReturn)
   Dim ws,MyCmd,Resultat
   Set ws = CreateObject("wscript.Shell")
'La valeur 0 pour cacher la console MS-DOS
   If Console = 0 Then
      MyCmd = "CMD /C " & StrCmd & ""
      Resultat = ws.run(MyCmd,Console,bWaitOnReturn)
      If Resultat = 0 Then
      Else
         MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
      End If
   End If
'La valeur 1 pour montrer la console MS-DOS
   If Console = 1 Then
      MyCmd = "CMD /K " & StrCmd & " "
      Resultat = ws.run(MyCmd,Console,bWaitOnReturn)
      If Resultat = 0 Then
      Else
         MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
      End If
   End If
   Executer = Resultat
End Function
'***********************************************************************************************************
Function Compression(Source,Destination,Password)
    Dim oFSO,oShell,aScriptFilename,sScriptFilename
    Dim sWorkingDirectory,ProgramFiles,sWinZipLocation
    Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
    Set oShell = WScript.CreateObject("Wscript.Shell")
'--------Trouver le répertoire de travail--------
    aScriptFilename = Split(Wscript.ScriptFullName, "\")
    sScriptFilename = aScriptFileName(Ubound(aScriptFilename))
    sWorkingDirectory = Replace(Wscript.ScriptFullName, sScriptFilename, "")
'--------------------------------------
    ProgramFiles = oShell.ExpandEnvironmentStrings("%ProgramFiles%")
'-------S'assurer que nous pouvons trouver WinRAR.exe------
    If oFSO.FileExists(sWorkingDirectory & " " & "Winrar.EXE") Then
        sWinZipLocation = ""
    ElseIf oFSO.FileExists(ProgramFiles &"\Winrar\Winrar.EXE") Then
        sWinZipLocation = ProgramFiles &"\Winrar\"
    Else
        Compression = "Erreur: Impossible de trouver Winrar.EXE"
        MsgBox Compression,16,Compression
        Exit Function
    End If
'--------------------------------------
'La Commande A : Signifie ==> ajouter à une archive
'Le Commutateur -IBCK ==> Signifie : Lancer WinRAR en arrière-plan
    If Password = "" Then
        oShell.Run """" & sWinZipLocation & "winrar.exe"" A -IBCK """ & _
        Destination & """ """ & Source & """",0,True 
    Else
'Le Commutateur -P<mot_de_passe> : Pour utiliser un mot de passe
        oShell.Run """" & sWinZipLocation & "winrar.exe"" A -IBCK -p"&Password&" """ & _
        Destination & """ """ & Source & """",0,True 
    End If
    If oFSO.FileExists(Destination) Then
        Compression = 1
    Else
        Compression = "Erreur : Création d'archives a échoué !"
        MsgBox Compression,16,Compression
    End If
End Function
'***********************************************************************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(strIn)
   DblQuote = Chr(34) & strIn & Chr(34)
End Function
'***********************************************************************************************************
Sub CreateProgressBar(Titre,MsgAttente)
    Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
    Set ws = CreateObject("wscript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Temp = WS.ExpandEnvironmentStrings("%Temp%")
    PathOutPutHTML = Temp & "\Barre.hta"
    Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
    fhta.WriteLine "<HTML>"
    fhta.WriteLine "<HEAD>"
    fhta.WriteLine "<Title>  " & Titre & "</Title>"
    fhta.WriteLine "<HTA:APPLICATION"
    fhta.WriteLine "ICON = ""magnify.exe"" "
    fhta.WriteLine "BORDER=""THIN"" "
    fhta.WriteLine "INNERBORDER=""NO"" "
    fhta.WriteLine "MAXIMIZEBUTTON=""NO"" "
    fhta.WriteLine "MINIMIZEBUTTON=""NO"" "
    fhta.WriteLine "SCROLL=""NO"" "
    fhta.WriteLine "SYSMENU=""NO"" "
    fhta.WriteLine "SELECTION=""NO"" "
    fhta.WriteLine "SINGLEINSTANCE=""YES"">"
    fhta.WriteLine "</HEAD>"
    fhta.WriteLine "<BODY text=""white""><CENTER><DIV><SPAN ID=""ProgressBar""></SPAN>"
    fhta.WriteLine "<span><marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & MsgAttente &"</font></marquee></span></DIV></CENTER></BODY></HTML>"
    fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> "
    fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")"
    fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")"
    fhta.WriteLine "Sub window_onload()"
    fhta.WriteLine "    CenterWindow 500,90"
    fhta.WriteLine "    Self.document.bgColor = ""DarkOrange"" "
    fhta.WriteLine " End Sub"
    fhta.WriteLine " Sub CenterWindow(x,y)"
    fhta.WriteLine "    Dim iLeft,itop"
    fhta.WriteLine "    window.resizeTo x,y"
    fhta.WriteLine "    iLeft = window.screen.availWidth/2 - x/2"
    fhta.WriteLine "    itop = window.screen.availHeight/2 - y/2"
    fhta.WriteLine "    window.moveTo ileft,itop"
    fhta.WriteLine "End Sub"
    fhta.WriteLine "</script>"
    fhta.close
End Sub
'**********************************************************************************************
Sub LancerProgressBar()
    Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
End Sub
'**********************************************************************************************
Sub FermerProgressBar()
    oExec.Terminate
End Sub
'**********************************************************************************************
Sub Pause(NSeconds)
    Wscript.Sleep(NSeconds*1000)
End Sub  
'**********************************************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************

02/06/2014, 13h30
01Please

Toujours pareille : le logiciel blog note s'ouvre avec le fichier "MyXCopyLog" et cette ligne est écrite : Remplacer C:\Documents\Archive_2_6_2014\scriptSuppressionLEVEL3(40jours).vbs (Oui/Non/Tous)? :?
02/06/2014, 13h39
hackoofr

Citation:

Envoyé par 01Please

Toujours pareille : le logiciel blog note s'ouvre avec le fichier "MyXCopyLog" et cette ligne est écrite : Remplacer C:\Documents\Archive_2_6_2014\scriptSuppressionLEVEL3(40jours).vbs (Oui/Non/Tous)? :?

Par contre moi j'ai ce message : 0 fichier(s) copié(s)
02/06/2014, 13h46
01Please

oui j'avais ce message avant et depuis que j'ai changé les options de la commande Xcopy en rajoutant /Y et /E, j'ai ce message qui s'affiche...
02/06/2014, 14h07
hackoofr

Citation:

Envoyé par 01Please

oui j'avais ce message avant et depuis que j'ai changé les options de la commande Xcopy en rajoutant /Y et /E, j'ai ce message qui s'affiche...

Il y a une différence entre ce que vous avez écrit :

Code:

Param = " /D /E /Y "

par contre il faut faire ceci

Code:

Param = " /D /Y /E"

sans espace à la fin
02/06/2014, 14h40
01Please

D'accord mais pourquoi le problème est toujours présent :/ J'aurai voulu supprimer les fichiers MyTmpXLogCopy pour mettre au propre mon répertoire (peut-être le problème vient d'ici car votre code fonctionne parfaitement... mais impossible de le supprimer car il serait ouvert dans l’interpréteur de commande sauf qu'il n'y a aucun invite de commande d'ouvert :)

Citation:

Envoyé par 01Please

D'accord mais pourquoi le problème est toujours présent :/ J'aurai voulu supprimer les fichiers MyTmpXLogCopy pour mettre au propre mon répertoire (peut-être le problème vient d'ici car votre code fonctionne parfaitement... mais impossible de le supprimer car il serait ouvert dans l’interpréteur de commande sauf qu'il n'y a aucun invite de commande d'ouvert :)

:salut:
Essayez de nettoyer vos processus et teste de nouveau au propre avec ProcessKiller.vbs

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
Titre = " Processus "& qq("Wscript.exe") &" en cours d'exécution "
Set fso = CreateObject("Scripting.FileSystemObject")
Set sho = CreateObject( "Wscript.Shell" )
NomFichierLog="Processus VBScript.txt"
temp = sho.ExpandEnvironmentStrings("%temp%")
PathNomFichierLog = temp & "\" & NomFichierLog
Set OutPut = fso.CreateTextFile(temp & "\" & NomFichierLog,1)
count=0 
strComputer = "."
Call Find("Wscript.exe")
Call Find("cmd.exe")
Call Find("Xcopy.exe")
 
Call Explorer(PathNomFichierLog)
'***************************************************************************************************
Function Explorer(File)
    Set ws=CreateObject("wscript.shell")
    ws.run "Explorer "& File & "\",1,True
end Function
'***************************************************************************************************
Sub Find(MyProcess)
    Set colItems = GetObject("winmgmts:").ExecQuery("Select * from Win32_Process " _
    & "Where Name like '%"& MyProcess &"%' AND NOT commandline like '%" & wsh.scriptname & "%'",,48)
    For Each objItem in colItems
        MsgBox "Arrêter ce script : " & objItem.CommandLine,48,Titre
        count= count + 1
        'msgbox Mid(objItem.CommandLine,InStr(objItem.CommandLine,""" """) + 2),64,Titre
        OutPut.WriteLine Mid(objItem.CommandLine,InStr(objItem.CommandLine,""" """) + 2)
        objItem.Terminate(0)
    Next
'OutPut.WriteLine
'OutPut.WriteLine count & Titre & "ont été arrêtés"
End Sub
'***************************************************************************************************
Function qq(strIn)
    qq = Chr(34) & strIn & Chr(34)
End Function
'***************************************************************************************************

02/06/2014, 15h06
01Please

En faite c'est bon :king: , j'ai éteins l'ordinateur et j'ai pu supprimer les fichiers, tout fonctionne bien maintenant, je n'ai pas eu besoin d'exécuter le fichier ProcessKiller.vbs (mais je le garde précieusement au cas où ;) ) votre aide a été très utile et je vous en remercie pour toute cette patience que vous avez eu ^^ Merciiiiiiiiiii :D
Problème résolu !

Comment modifier ce script pour envoyer l'archive sur un autre disque et non dans mes documents ? ^^

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
Option Explicit
Dim sSrc,sDest,MyCmd,Temp,Titre,MsgTitre,MsgAttente,Source,Destination,bf
Dim oExec,ws,LogTmpFile,LogFile,Param,Archive,MyDoc,fso
Set ws = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
sSrc = Parcourir_Dossier()
MyDoc = ws.SpecialFolders("MyDocuments")'Dossier Mes Documents
Set bf = fso.GetFolder(MyDoc)
Archive  = "Archive_"& Day(Now) & "_" & Month(Now) & "_" & Year(Now)
sDest = MyDoc & "\" & Archive
Call CreateFolder(bf,Archive)
LogTmpFile = "MyTmpXCopyLog.txt"
LogFile = "MyXCopyLog.txt"
Param = " /D /Y /E"
MyCmd = "XCopy" & " " & DblQuote(sSrc) & " " & DblQuote(sDest) & " " & Param &" > " & LogTmpFile &_
" & cmd /U /C Type " & LogTmpFile & " > " & LogFile & " & Del " & LogTmpFile & ""
Titre = "Copie de Sauvegarde " 
MsgAttente = "Copie de Sauvegarde : <font color=Yellow>" & DblQuote(sSrc) & " vers " & DblQuote(sDest) & " </font>  . . . ."
Call CreateProgressBar(Titre,MsgAttente)
Call LancerProgressBar()
Call Pause(2)
Call Executer(MyCmd,0,True)
'Maintenant on définie les varaiables Source et Destination pour archiver la source avec Winrar vers la destination
'Source = sDest
'Destination = sDest &".rar"
'Call Compression(Source,Destination,"")' Compression sans mot de passe
Call FermerProgressBar()
ws.run LogFile
'****************************************************************************************************
Function Parcourir_Dossier()
    Dim objShell,objFolder
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0, "Veuillez choisir un dossier pour la Sauvegarde " ,1,"c:\Programs")
    If objFolder Is Nothing Then
        Wscript.Quit
    End If
    Parcourir_Dossier = objFolder.self.path
end Function
'**************************************************************************************************************
Sub CreateFolder(bf,name)
    Set fso  = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(bf & "\" & name) Then
        bf.subFolders.Add(name)
        Else : Exit Sub
    End If
End Sub
'**************************************************************************************************************
Function Executer(StrCmd,Console,bWaitOnReturn)
   Dim ws,MyCmd,Resultat
   Set ws = CreateObject("wscript.Shell")
'La valeur 0 pour cacher la console MS-DOS
   If Console = 0 Then
      MyCmd = "CMD /C " & StrCmd & ""
      Resultat = ws.run(MyCmd,Console,bWaitOnReturn)
      If Resultat = 0 Then
      Else
         MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
      End If
   End If
'La valeur 1 pour montrer la console MS-DOS
   If Console = 1 Then
      MyCmd = "CMD /K " & StrCmd & " "
      Resultat = ws.run(MyCmd,Console,bWaitOnReturn)
      If Resultat = 0 Then
      Else
         MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
      End If
   End If
   Executer = Resultat
End Function
'***********************************************************************************************************
'Function Compression(Source,Destination,Password)
'    Dim oFSO,oShell,aScriptFilename,sScriptFilename
'    Dim sWorkingDirectory,ProgramFiles,sWinZipLocation
'    Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
'    Set oShell = WScript.CreateObject("Wscript.Shell")
'--------Trouver le répertoire de travail--------
'    aScriptFilename = Split(Wscript.ScriptFullName, "\")
'    sScriptFilename = aScriptFileName(Ubound(aScriptFilename))
'    sWorkingDirectory = Replace(Wscript.ScriptFullName, sScriptFilename, "")
'--------------------------------------
'    ProgramFiles = oShell.ExpandEnvironmentStrings("%ProgramFiles%")
'-------S'assurer que nous pouvons trouver WinRAR.exe------
'    If oFSO.FileExists(sWorkingDirectory & " " & "Winrar.EXE") Then
'        sWinZipLocation = ""
'    ElseIf oFSO.FileExists(ProgramFiles &"\Winrar\Winrar.EXE") Then
'        sWinZipLocation = ProgramFiles &"\Winrar\"
'    Else
'        Compression = "Erreur: Impossible de trouver Winrar.EXE"
'        MsgBox Compression,16,Compression
'        Exit Function
'    End If
'--------------------------------------
'La Commande A : Signifie ==> ajouter à une archive
'Le Commutateur -IBCK ==> Signifie : Lancer WinRAR en arrière-plan
'    If Password = "" Then
'        oShell.Run """" & sWinZipLocation & "winrar.exe"" A -IBCK """ & _
'        Destination & """ """ & Source & """",0,True 
'    Else
'Le Commutateur -P<mot_de_passe> : Pour utiliser un mot de passe
'        oShell.Run """" & sWinZipLocation & "winrar.exe"" A -IBCK -p"&Password&" """ & _
'        Destination & """ """ & Source & """",0,True 
'    End If
'    If oFSO.FileExists(Destination) Then
'        Compression = 1
'    Else
'        Compression = "Erreur : Création d'archives a échoué !"
'        MsgBox Compression,16,Compression
'   End If
'End Function
'***********************************************************************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(strIn)
   DblQuote = Chr(34) & strIn & Chr(34)
End Function
'***********************************************************************************************************
Sub CreateProgressBar(Titre,MsgAttente)
    Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
    Set ws = CreateObject("wscript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Temp = WS.ExpandEnvironmentStrings("%Temp%")
    PathOutPutHTML = Temp & "\Barre.hta"
    Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
    fhta.WriteLine "<HTML>"
    fhta.WriteLine "<HEAD>"
    fhta.WriteLine "<Title>  " & Titre & "</Title>"
    fhta.WriteLine "<HTA:APPLICATION"
    fhta.WriteLine "ICON = ""magnify.exe"" "
    fhta.WriteLine "BORDER=""THIN"" "
    fhta.WriteLine "INNERBORDER=""NO"" "
    fhta.WriteLine "MAXIMIZEBUTTON=""NO"" "
    fhta.WriteLine "MINIMIZEBUTTON=""NO"" "
    fhta.WriteLine "SCROLL=""NO"" "
    fhta.WriteLine "SYSMENU=""NO"" "
    fhta.WriteLine "SELECTION=""NO"" "
    fhta.WriteLine "SINGLEINSTANCE=""YES"">"
    fhta.WriteLine "</HEAD>"
    fhta.WriteLine "<BODY text=""white""><CENTER><DIV><SPAN ID=""ProgressBar""></SPAN>"
    fhta.WriteLine "<span><marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & MsgAttente &"</font></marquee></span></DIV></CENTER></BODY></HTML>"
    fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> "
    fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")"
    fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")"
    fhta.WriteLine "Sub window_onload()"
    fhta.WriteLine "    CenterWindow 500,90"
    fhta.WriteLine "    Self.document.bgColor = ""DarkOrange"" "
    fhta.WriteLine " End Sub"
    fhta.WriteLine " Sub CenterWindow(x,y)"
    fhta.WriteLine "    Dim iLeft,itop"
    fhta.WriteLine "    window.resizeTo x,y"
    fhta.WriteLine "    iLeft = window.screen.availWidth/2 - x/2"
    fhta.WriteLine "    itop = window.screen.availHeight/2 - y/2"
    fhta.WriteLine "    window.moveTo ileft,itop"
    fhta.WriteLine "End Sub"
    fhta.WriteLine "</script>"
    fhta.close
End Sub
'**********************************************************************************************
Sub LancerProgressBar()
    Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
End Sub
'**********************************************************************************************
Sub FermerProgressBar()
    oExec.Terminate
End Sub
'**********************************************************************************************
Sub Pause(NSeconds)
    Wscript.Sleep(NSeconds*1000)
End Sub  
'**********************************************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************

Je dois crée un deuxième script qui permet de récupérer dans un fichier texte .txt un lettre
par exemple :
archive = h
courant = f

dans le script quand on initialise les variables source et destination, il faut --> Source = " .... " il faudrait récupérer la lettre ... je sais qu'il y a une méthode avec split " " mais je n'ai jamais utilisé cette méthode :/

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
   Const ctePourLecture = 1
      Const varNomFic = "C:\custom\application.txt"
      Dim objFSO, objFichier, Texte, Message
      Dim Chaine, Position
      Set objFSO = CreateObject("Scripting.FileSystemObject")
      If ( objFSO.FileExists(varNomFic) ) Then
        Set objFichier = objFSO.OpenTextFile(varNomFic, ctePourLecture)
        'we open XML tag <WARRANTY>
        wscript.echo "<accountinfo>"
        'while we are not at the end of file
        While Not objFichier.AtEndOfStream
            'we read the file line by line
            chaine = objFichier.ReadLine
           'if chain contains "archive =
            If Instr(1,chaine, "archive =") <> 0 Then
                    'we retrieve 2 chains separeted by "Version=" in a table
                    mTab = Split(chaine, "archive =")
                    'we diplay the second chain in XML archive  <archive >
                    wscript.echo "<archive >"& mTab(1) & "</archive >"
            End If 
            'if chain contains "courant=
            If Instr(1,chaine, "courant=") <> 0 Then
                    'we retrieve 2 chains separeted by "Version=" in a table
                    mTab = Split(chaine, "courant=")
                    'we diplay the second chain in XML tag <courant>
                    wscript.echo "<courant>"& mTab(1) & "</courant>"
            End If
 
        Wend
        objFichier.Close
        wscript.echo "</accountinfo>"
        Set objFichier = Nothing
      Else
        WScript.Echo "File absent"
      End If
      Set objFSO = Nothing
    WScript.Quit(0)
'End of script

Retourne --> File absent

Lien nouvelle discussion : Script vbs pour archiver des fichiers, avec un fichier texte permettant de trouver le chemin des fichiers

03/06/2014, 12h33
hackoofr

:salut:
Je vous recommande de supprimer ces deux derniers messages et de les copier dans une nouvelle discussion avec un titre significatif, car cette discussion est :resolu:
Pour Chaque nouvelle question ==> une Nouvelle discussion :mouarf:
Vous pouvez également mentionner le lien de cette discussion et vous commenciez par "Suite à cette discussion Le lien ici etc....... puis poser votre nouveau problème"
Amicalement ! :zoubi: