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

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

Suite à cette disussion Le lien.

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

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

Je vous explique pourquoi je voudrais faire ceci : car les disques sur lesquelles les sauvegardes sont effectuées seront enlevés et remis du coup leur chemin peut changer ...

**hackoofr** · 03/06/2014, 16h55

Il y a quoi exactement dans ce fichier : application.txt

**01Please** · 03/06/2014, 17h04

Dans ce fichier, il y a seulement deux lignes :

archive = h
courant = f

**01Please** · 03/06/2014, 17h09

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
   Const ctePourLecture = 1
      Const varNomFic = "T:\ddletter.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)
 
        '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  mTab(1) 
            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 mTab(1) 
            End If
 
        Wend
        objFichier.Close
         Set objFichier = Nothing
      Else
        WScript.Echo "File absent"
      End If
      Set objFSO = Nothing
    WScript.Quit(0)
'End of script

J'arrive à récupérer la lettre h mais pas la lettre f :/

**01Please** · 03/06/2014, 17h12

Enfaite j'ai réussi à récuppérer les deux lettres

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
   Const ctePourLecture = 1
      Const varNomFic = "T:\ddletter.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)
 
        '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  mTab(1) 
            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 mTab(1) 
            End If
 
        Wend
        objFichier.Close
         Set objFichier = Nothing
      Else
        WScript.Echo "File absent"
      End If
      Set objFSO = Nothing
    WScript.Quit(0)
'End of script

Il manquait des espaces, maintenant j'aimerais que ces lettres soient prises en compte pour changer les chemins de ce script :

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

Sachant qu'il faudrait un script automatique donc il faut éviter de faire Set objFolder = objShell.BrowseForFolder(0, "Veuillez choisir un dossier pour la Sauvegarde " ,1,"c:\Programs")

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

Je cherche comment faire aussi pour copier seulement les fichiers supérieurs à une date -1 : je m'explique grâce à ce code :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
'Initialisation du nom du fichier
   sFileName = "T:\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:\Verification_Sauvegarde.txt" ) = True Then 
 Set oFile = fso.GetFile("T:\Verification_Sauvegarde.txt" ) 
 dtmDateModifie = oFile.DateLastModified
 Set oFolder = Nothing 
Else 
 dtmDateModifie = "Unknown" 
End if

Dans Verification_Sauvegarde.txt:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
'Nom du Fichier  Vérification Sauvegarde  suivant  La Date  systeme
LogFile_Verification = "Verification_Sauvegarde"
 
'Initialisation des objets 
Set fso = CreateObject("Scripting.FileSystemObject" )
Set OutPut = fso.CreateTextFile("T:\" & LogFile_Verification & ".txt",8)
OutPut.WriteLine "*************************************************************************************************"
OutPut.WriteLine "La dernière vérification de sauvegarde a été effectué le  " &  Day(Now) & "/" & Month(Now) & "/" & Year(Now)& " à " & Time 
OutPut.WriteLine "*************************************************************************************************"
 
MsgBox("************************************************************************************** La verification de sauvegarde a ete effectue **************************************************************************************")

donc par exemple dtmDateModifie = 30/05/2014 à 16:54:00
il faudrait que je copie seulement les fichiers datant de 29/05/2014 et 30/05/2014

**hackoofr** · 04/06/2014, 21h01

Voici un script MyDriveList.vbs qui vous liste tous les lecteurs avec leurs types càd (Fixe,Amovible,CD-ROM ou bien de type réseau)
Par exemple le résultat que j'obtiens chez moi est de cette forme :

C: - Lecteur fixe
D: - Lecteur de CD-ROM
E: - Lecteur fixe
F: - Lecteur de CD-ROM
G: - Lecteur de CD-ROM
I: - Lecteur amovible
W: - Lecteur réseau ou distant

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
Option Explicit
Const ForAppending = 8
Dim MaListeDrives,MyDrives,ws,objFSO
Dim objLogFile,objWMIService,objDisk,MaCommande
MaListeDrives = "_drives.cf"
MyDrives = "AllMyDrives.txt"
Set ws = CreateObject("wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(MaListeDrives) Then
    objFSO.DeleteFile(MaListeDrives)
end if
If objFSO.FileExists(MyDrives) Then
    objFSO.DeleteFile(MyDrives)
End if
Set objLogFile = objFSO.OpenTextFile(MaListeDrives, ForAppending, True)
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & "." & "\root\cimv2")
For Each objDisk in objWMIService.ExecQuery ("Select * from Win32_LogicalDisk")
    If objDisk.DriveType = "2" Or objDisk.DriveType = "3" Or objDisk.DriveType = "4" Or objDisk.DriveType = "5" Then 
        objLogFile.Writeline(objDisk.DeviceID)
    End If
Next
MaCommande = "FOR /f %g in ('findstr.exe /v /i ""a: b:"" "& MaListeDrives &"') DO (fsutil fsinfo drivetype %g >> TmpDrives.txt) & Cmd /U /C Type TmpDrives.txt >> "& MyDrives &" & Del TmpDrives.txt"
Call Executer(MaCommande,0,True)
ws.run MyDrives
'**************************************************************************************************************
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
'***************************************************************************************************

**01Please** · 10/06/2014, 10h24

Voici le script que j'ai réalisé pour récupérer la lettre du lecteur ...

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
 Dim sArchive
 
'Initialisation du nom du fichier
   sFileName = "T:\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:\Verification_Sauvegarde.txt" ) = True Then 
 Set oFile = fso.GetFile("T:\Verification_Sauvegarde.txt" ) 
 dtmDateModifie = oFile.DateLastModified
 Set oFolder = Nothing 
Else 
 dtmDateModifie = "Unknown" 
End if 
 
   Const ctePourLecture = 1
      Const varNomFic = "T:\ddletter.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)
 
        '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, " = ")
                    'we diplay the second chain in XML archive  <archive >
                    sArchive =  mTab(1) 
            End If 
 
 
 
           '-------------retourne la lettre du disque courant -------
		   'if chain contains "courant =
            If Instr(1,chaine, "courant =") <> 0 Then
                    'we retrieve 2 chains separeted by "Version=" in a table
                    mTab = Split(chaine, " = ")
                    'we diplay the second chain in XML tag <courant>
                    sCourant = mTab(1) 
            End If
 
        Wend
 
Dim ws,Archive,fso
Set ws = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Archive  = "Archive_"& Day(Now) & "_" & Month(Now) & "_" & Year(Now)
 
 
path = CStr(sCourant)
pathDestination = CStr(sArchive & "/" & Archive)
 
 
 
 
		fso.CopyFolder path, pathDestination, true
 
 
 
 
 
        objFichier.Close
         Set objFichier = Nothing
      Else
        WScript.Echo "File absent"
      End If
      Set objFSO = Nothing
    WScript.Quit(0)

je n'ai pas vraiment compris votre script mais mon script fonctionne. Sauf qu'il faudrait trouver la solution comment copier seulement les fichiers supérieurs à 1 jour par rapport à une date.

Pour récupérer une date, je fais :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
'Initialisation du nom du fichier
   sFileName = "T:\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:\Verification_Sauvegarde.txt" ) = True Then 
 Set oFile = fso.GetFile("T:\Verification_Sauvegarde.txt" ) 
 dtmDateModifie = oFile.DateLastModified
 Set oFolder = Nothing 
Else 
 dtmDateModifie = "Unknown" 
End if

Je pense qu'il faut que j'intégrer un code de ce style :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
AgeMaximalFichiers = "28" 
 
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
 
        End If 
Next

**01Please** · 10/06/2014, 11h00

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
  Dim sArchive
 
'Initialisation du nom du fichier
   sFileName = "T:\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:\Verification_Sauvegarde.txt" ) = True Then 
 Set oFile = fso.GetFile("T:\Verification_Sauvegarde.txt" ) 
 dtmDateModifie = oFile.DateLastModified
 Set oFolder = Nothing 
Else 
 dtmDateModifie = "Unknown" 
End if 
 
   Const ctePourLecture = 1
      Const varNomFic = "T:\ddletter.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)
 
        '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, " = ")
                    'we diplay the second chain in XML archive  <archive >
                    sArchive =  mTab(1) 
            End If 
 
 
 
           '-------------retourne la lettre du disque courant -------
		   'if chain contains "courant =
            If Instr(1,chaine, "courant =") <> 0 Then
                    'we retrieve 2 chains separeted by "Version=" in a table
                    mTab = Split(chaine, " = ")
                    'we diplay the second chain in XML tag <courant>
                    sCourant = mTab(1) 
            End If
 
        Wend
 
 
 
 
Dim ws,Archive,fso 
Dim Titre, MsgAttente, Temp
Dim Folder, path
Set ws = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
AgeMaximalFichiers = "0"
 
Archive  = "Archive_"& Day(Now) & "_" & Month(Now) & "_" & Year(Now)
 
 
path = CStr(sCourant)
 
pathDestination = CStr(sArchive & "/" & Archive)
 
sub copyFolder(path)
set Folder = fso.GetFolder(path)
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 
 
	    fso.CopyFolder path, pathDestination, true
 
        End If 
Next
End Sub
 
 
        objFichier.Close
         Set objFichier = Nothing
      Else
        WScript.Echo "File absent"
      End If
      Set objFSO = Nothing
    WScript.Quit(0)
 
 
 
Titre = "Copie de Sauvegarde " 
MsgAttente = "Copie de Sauvegarde : <font color=Yellow>" & " </font>  . . . ."
Call CreateProgressBar(Titre,MsgAttente)
Call LancerProgressBar()
Call copyFolder(path)
Call Pause(2)
Call FermerProgressBar()
	'***********************************************************************************************************
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  
'**********************************************************************************************

Pourquoi ce script ne prend pas en compte la date ??? Il copie tous les fichiers, je n'arrive pas à copier seulement les fichiers supérieur à 1 jours de la date dtmDateModifie ...

**l_autodidacte** · 11/06/2014, 21h10

Il y a deux choses qui empêchent la copie selon le critère voulu :
1 - La variable dtmDateModifie n'est autre que la dernière date de modification du fichier(ou dossier)
2 - la constante (ou variable ??) AgeMaximalFichiers a été initialisée à la valeur 0(zéro) ce qui veut dire que la condition devrait chercher une date future, ce qui n'est vrai.
Or d'après If (DateDiff("d", File.DateLastModified, dtmDateModifie) < CInt(AgeMaximalFichiers)) Then ne sera jamais vraie puisque les 2 arguments sont de même valeur.

**01Please** · 12/06/2014, 10h18

Voici le code que j'ai créé, il fonctionne mais ne parcourt pas les sous dossiers :/

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
 Dim sArchive
   '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("C:\Verification_Sauvegarde.txt" ) = True Then 
	Set oFile = fso.GetFile("C:\Verification_Sauvegarde.txt" ) 
	LastDateVerif = oFile.DateLastModified
	Set oFolder = Nothing 
Else 
	LastDateVerif = "Unknown" 
	MsgBox ("Error verification date. 'Unknow'")
	wscript.quit
End if 
 
 
   Const ctePourLecture = 1
      Const nomFichierChemin = "C:\ddletter.txt"
      Dim objFSO, objFichier
      Dim Chaine
      Set objFSO = CreateObject("Scripting.FileSystemObject")
      If ( objFSO.FileExists(nomFichierChemin) ) Then
        Set objFichier = objFSO.OpenTextFile(nomFichierChemin, ctePourLecture)
 
        '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, " = ")
                    'we diplay the second chain in XML archive  <archive >
                    sArchive =  mTab(1) 
            End If 
 
 
 
           '-------------retourne la lettre du disque courant -------
		   'if chain contains "courant =
            If Instr(1,chaine, "courant =") <> 0 Then
                    'we retrieve 2 chains separeted by "Version=" in a table
                    mTab = Split(chaine, " = ")
                    'we diplay the second chain in XML tag <courant>
                    sCourant = mTab(1) 
            End If
 
        Wend
 
 
 
 
 
'Création dossier Archive
Dim ws,Archive,fso 
Dim Folder, path
Set ws = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
 
Archive  = "Archive_"& Day(Now) & "_" & Month(Now) & "_" & Year(Now)
path = CStr(sCourant)
pathDestinationFolder = CStr(sArchive & "\" & Archive)
 
	If fso.FolderExists(pathDestinationFolder) Then 
		fso.DeleteFolder pathDestinationFolder 
	End If 
 
Set objFolder = fso.CreateFolder(pathDestinationFolder)
set Folder = fso.GetFolder(path)
 
 
 
'Parcourir tous les fichiers du répertoire courant pour copier dans le dossier destination
For Each File In Folder.Files 
	dateModifie = File.DateLastModified
	NbrJoursVerifAndModif = DateDiff("d", dateModifie , LastDateVerif)
	AgeMaximalFichiers = 10
 
		If (NbrJoursVerifAndModif <= CInt(AgeMaximalFichiers) AND NbrJoursVerifAndModif >= 0 ) Then 
 
			'On verifie qu'ils ne sont pas en lecture seule 
			If File.Attributes And 1 Then File.Attributes = File.Attributes - 1 
				pathSource = File.Path 
				pathDestination = pathDestinationFolder + "\" + File.Name
				'Copie des fichiers correspondants
				fso.CopyFile pathSource, pathDestination, true
 
			Else
 
		End If 
Next
 
 
 
 
      objFichier.Close
      Set objFichier = Nothing
      Else
        WScript.Echo "File absent"
      End If
      Set objFSO = Nothing
    WScript.Quit(0)

**l_autodidacte** · 12/06/2014, 14h39

Essaie d'adapter ce Code et tout ira bien

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

VBScript

Discussions similaires

Partager

Partager