Bonjour,
Je ne sais pas si c'est le bon endroit pour poster, mais les personnes interréssées sauront trouver l'info.
Pour créer un équivalent XCopy /D (dos) en VBA (pour ne copier que les fichiers les plus récents)
La référence "Microsofr Scripting RunTime" doit être cochée
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 Option Explicit Dim oFSO As New FileSystemObject Dim oTXT As Scripting.TextStream Dim FichiersCréés%, FichierRemplacés%, DossiersCréés% Private Sub Sauvegarde() Dim oFLDSource As Scripting.Folder, oFLDCible As Scripting.Folder Dim oSubFoldSource As Scripting.Folder, oSubFoldCible As Scripting.Folder Dim oFileSource As Scripting.File, oFileCible As Scripting.File Dim HeureDebut As Date Dim Source$, Cible$ Source = "D:\Analyst Data" Cible = "R:\API3000" HeureDebut = Now If Not oFSO.FolderExists Then oFSO.CreateFolder Cible 'Crée le fichier Cible s'il n'existe pas Set oFLDSource = oFSO.GetFolder(Source) Set oFLDCible = oFSO.GetFolder(Cible) Set oTXT = oFSO.OpenTextFile(Cible & "\Sauvegarde.txt", ForAppending) oTXT.WriteLine "Sauvegarde du " & Now For Each oSubFoldSource In oFLDSource.SubFolders VerificationSubFolder oSubFoldSource, oFLDSource.Path, oFLDCible.Path Next With oTXT .WriteLine (FichiersCréés & " fichier(s) créé(s)") .WriteLine (FichierRemplacés & " fichier(s) remplacé(s)") .WriteLine (DossiersCréés & " Dossier(s) créé(s)") .WriteLine "Fin de transfert : " & Now & " (" & Round((Now - HeureDebut) * 1500, 3) & " minutes)" .Close End With End Sub Private Sub VerificationSubFolder(oFldS As Scripting.Folder, DossierSource$, DossierCible$) Dim oSubFolderSource As Scripting.Folder, oSubFolderCible As Scripting.Folder Dim oFld As Scripting.Folder Dim oflSource As Scripting.File, oflCible As Scripting.File If oFSO.FolderExists(Replace(oFldS.Path, DossierSource, DossierCible)) Then Set oFld = oFSO.GetFolder(Replace(oFldS.Path, DossierSource, DossierCible)) For Each oflSource In oFldS.Files 'Vérification existence des fichiers dans le dossier cible If oFSO.FileExists(Replace(oflSource.Path, DossierSource, DossierCible)) Then 'Fichier existe dans le dossier cible Set oflCible = oFSO.GetFile(Replace(oflSource.Path, DossierSource, DossierCible)) 'Comparaison des dates de modification If oflCible.DateLastModified < oflSource.DateLastModified Then 'Fichier Source plus récent que le fichier cible oTXT.WriteLine ("Remplacement du fichier " & oflSource) 'Copie du fichier avec ecrasement du fichier cible en respectant l'arborescence oflCible.Copy Replace(oflSource.Path, DossierSource, DossierCible), True FichierRemplacés = FichierRemplacés + 1 End If Else 'Le fichier cible n'existe pas oTXT.WriteLine ("Copie du fichier " & oflSource) oflCible.Copy Replace(oflSource.Path, DossierSource, DossierCible) FichiersCréés = FichiersCréés + 1 End If Next For Each oSubFolderSource In oFldS.SubFolders VerificationSubFolder oSubFolderSource, DossierSource, DossierCible Next Else oTXT.WriteLine ("Création du dossier " & oFldS.Path) DossiersCréés = DossiersCréés + 1 oFldS.Copy Replace(oFldS.Path, DossierSource, DossierCible) End If End Sub
En VBS : Copier le texte suivant dans un fichier BlocNote, enregistrer sous "Sauvegarde.vbs", puis plannifier une tâche par le planificateur de tache Windows pour effectuer la sauvegarde quotidiennement:
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 Dim FichiersCrees, FichierRemplaces, DossiersCrees, oTXT, Source, Cible FichiersCrees=0 FichierRemplaces=0 DossiersCrees =0 Set oFSO = CreateObject("Scripting.FileSystemObject") HeureDebut = Now Source="C:\Xcalibur" Cible="R:\Focus" If Not oFSO.FolderExists(Cible) Then oFSO.CreateFolder (Cible) Set oFLDSource = oFSO.GetFolder(Source) Set oFLDCible = oFSO.GetFolder(Cible) set oTXT=oFSO.OpenTextFile(cible & "\Sauvegarde.txt", 8, true) oTXT.WriteLine " " oTXT.WriteLine "Sauvegarde du " & Now For Each oSubFoldSource In oFLDSource.SubFolders VerificationSubFolder oSubFoldSource, oFLDSource.Path, oFLDCible.Path Next oTXT.WriteLine (FichiersCrees & " fichier(s) créé(s)") oTXT.WriteLine (FichierRemplaces & " fichier(s) remplacé(s)") oTXT.WriteLine (DossiersCrees & " Dossier(s) créé(s)") oTXT.WriteLine "Fin de transfert : " & Now & " (" & round((Now - HeureDebut)*1500,3) & " minutes)" oTXT.Close Sub VerificationSubFolder(oFldS, DossierSource, DossierCible) If oFSO.FolderExists(Replace(oFldS.Path, DossierSource, DossierCible)) Then Set oFld = oFSO.GetFolder(Replace(oFldS.Path, DossierSource, DossierCible)) For Each oflSource In oFldS.Files If oFSO.FileExists(Replace(oflSource.Path, DossierSource, DossierCible)) Then Set oflCible = oFSO.GetFile(Replace(oflSource.Path, DossierSource, DossierCible)) If oflCible.DateLastModified < oflSource.DateLastModified Then oTXT.WriteLine ("Remplacement du fichier " & oflSource) oflCible.Copy Replace(oflSource.Path, DossierSource, DossierCible), True FichierRemplaces = FichierRemplaces + 1 End If Else 'Le fichier cible n'existe pas oTXT.WriteLine ("Copie du fichier " & oflSource) oflSource.Copy Replace(oflSource.Path, DossierSource, DossierCible) FichiersCrees = FichiersCrees + 1 End If Next For Each oSubFolderSource In oFldS.SubFolders VerificationSubFolder oSubFolderSource, DossierSource, DossierCible Next Else oTXT.WriteLine ("Création du dossier " & replace(oFldS.Path, DossierSource, DossierCible)) DossiersCrees = DossiersCrees + 1 oFldS.Copy Replace(oFldS.Path, DossierSource, DossierCible) End If End Sub
Partager