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

**01Please** · 02/06/2014, 11h35

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 ...

**hackoofr** · 02/06/2014, 11h45

Pas aussi compliqué

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

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

Il suffit de changer cette ligne en ajoutant ces commutateurs :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Param = " /D"

par celle-ci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Param = " /D /Y /E"

et le tour est joué

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
'**********************************************************************************************

**01Please** · 02/06/2014, 11h51

De ce point de vue c'est beaucoup plus simple

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 ?

**01Please** · 02/06/2014, 12h00

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 ?

**01Please** · 02/06/2014, 12h32

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :'(

**hackoofr** · 02/06/2014, 14h18

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

**hackoofr** · 02/06/2014, 14h25

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
'**********************************************************************************************

**01Please** · 02/06/2014, 14h30

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)?

**hackoofr** · 02/06/2014, 14h39

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)

**01Please** · 02/06/2014, 14h46

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...

**hackoofr** · 02/06/2014, 15h07

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

Param = " /D /E /Y "

par contre il faut faire ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Param = " /D /Y /E"

sans espace à la fin

**01Please** · 02/06/2014, 15h40

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

**hackoofr** · 02/06/2014, 15h56

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

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
'***************************************************************************************************

**01Please** · 02/06/2014, 16h06

En faite c'est bon

, 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

Problème résolu !

**01Please** · 03/06/2014, 12h10

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :/

**01Please** · 03/06/2014, 13h16

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**hackoofr** · 03/06/2014, 13h33

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

Pour Chaque nouvelle question ==> une Nouvelle discussion

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 !

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

VBScript

Discussions similaires

Partager

Partager