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

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

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, 15h55

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

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

Dans ce fichier, il y a seulement deux lignes :

archive = h
courant = f

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

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, 16h12

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, 17h16

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

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

VBScript

Vue hybride

Discussions similaires

Partager

Partager