Comparer des fichiers sur vbs
Résolu
DEEP_R
Messages postés
11
Date d'inscription
jeudi 21 septembre 2006
Statut
Membre
Dernière intervention
30 octobre 2006
-
27 sept. 2006 à 08:41
cs_JMO Messages postés 1854 Date d'inscription jeudi 23 mai 2002 Statut Membre Dernière intervention 24 juin 2018 - 7 oct. 2006 à 09:51
cs_JMO Messages postés 1854 Date d'inscription jeudi 23 mai 2002 Statut Membre Dernière intervention 24 juin 2018 - 7 oct. 2006 à 09:51
7 réponses
cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
27
27 sept. 2006 à 10:10
27 sept. 2006 à 10:10
Bonjour,
Exemple, en vbs, de "DateLastModified" et "DateDiff" .
jean-marc
Dim Path
Path = "d:\KRNSDE"
MsgBox ShowFolderList(Path),vbmessage,"Fichiers présents dans le répertoire"
Function ShowFolderList(strPath)
Dim fso, Dossiers, fic, fichiers, strListe, f, fdate, fname, dtDiffFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossiers = fso.GetFolder(path)
Set fic = Dossiers.Files
For Each fichiers in fic
Set f = fso.GetFile(fichiers)
fdate = f.DateLastModified
fname = f.Name
dtDiffFile = DateDiff("d", Now, fdate)
If dtDiffFile <= -5 Then
MsgBox "Le fichier " & Path & fname & " sera supprimé car créé le " & fdate
' fso.DeleteFile(Path & fname)
Else
MsgBox "Le fichier " & Path & fname & " ne sera pas supprimé car créé le " & fdate
End If
strListe = strListe & vbcrlf & vbcrlf & fname & " " & fdate
Next
ShowFolderList = strListe
End Function
Exemple, en vbs, de "DateLastModified" et "DateDiff" .
jean-marc
Dim Path
Path = "d:\KRNSDE"
MsgBox ShowFolderList(Path),vbmessage,"Fichiers présents dans le répertoire"
Function ShowFolderList(strPath)
Dim fso, Dossiers, fic, fichiers, strListe, f, fdate, fname, dtDiffFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossiers = fso.GetFolder(path)
Set fic = Dossiers.Files
For Each fichiers in fic
Set f = fso.GetFile(fichiers)
fdate = f.DateLastModified
fname = f.Name
dtDiffFile = DateDiff("d", Now, fdate)
If dtDiffFile <= -5 Then
MsgBox "Le fichier " & Path & fname & " sera supprimé car créé le " & fdate
' fso.DeleteFile(Path & fname)
Else
MsgBox "Le fichier " & Path & fname & " ne sera pas supprimé car créé le " & fdate
End If
strListe = strListe & vbcrlf & vbcrlf & fname & " " & fdate
Next
ShowFolderList = strListe
End Function
DEEP_R
Messages postés
11
Date d'inscription
jeudi 21 septembre 2006
Statut
Membre
Dernière intervention
30 octobre 2006
3 oct. 2006 à 17:44
3 oct. 2006 à 17:44
bonjour,
avant tout je tiens a te remercier pour ta solution apportée a mon probleme. jai travaillé dessus mais il y a quelque chose que je narrive malheuresement pas a comprendre;
Function ShowFolderList(strPath), le strpath doit etre remplacé par quoi? ce serait souhaitable si tu pouvais me donner un exemple plus ou moins simple.
MsgBox "Le fichier " & Path & fname & " sera supprimé car créé le " & fdate
' fso.DeleteFile(Path & fname
pour cette fonction, si je veux copier un fichier d'un repertoire a un autre, comment le faire? au fait, ce que je voudrais faire comme apllication cest de comparer un fichier par date; si celui ci date de 5jours, comme tu la indiqué dans ta preogrammation, au lieu de supprimer ce fichier, je voudrai copier un autre fichier se trouvant sur un repertoire D: et lemmener vers C:
jespere ke tu trouvera une solution a mon blème!
merci!
avant tout je tiens a te remercier pour ta solution apportée a mon probleme. jai travaillé dessus mais il y a quelque chose que je narrive malheuresement pas a comprendre;
Function ShowFolderList(strPath), le strpath doit etre remplacé par quoi? ce serait souhaitable si tu pouvais me donner un exemple plus ou moins simple.
MsgBox "Le fichier " & Path & fname & " sera supprimé car créé le " & fdate
' fso.DeleteFile(Path & fname
pour cette fonction, si je veux copier un fichier d'un repertoire a un autre, comment le faire? au fait, ce que je voudrais faire comme apllication cest de comparer un fichier par date; si celui ci date de 5jours, comme tu la indiqué dans ta preogrammation, au lieu de supprimer ce fichier, je voudrai copier un autre fichier se trouvant sur un repertoire D: et lemmener vers C:
jespere ke tu trouvera une solution a mon blème!
merci!
cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
27
3 oct. 2006 à 18:09
3 oct. 2006 à 18:09
Bonsoir,
C'était une erreur de saisie dans cet exemple, mais dans mon code
à un certain endroit, je définis le chemin dos des fichiers (shortPath.Name)
d'où ma variable strPath.
Il faut remplacer strPath
Path correspond à "c:" par ex.
Ex pour un fichier.
jean-marc
Dim Fichier
Fichier = "d:\test.txt"
Dim fso, Dossiers, f, fdate, fname, dtDiffFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(Fichier)
fdate = f.DateLastModified
fname = f.Name
dtDiffFile = DateDiff("d", Now, fdate)
If dtDiffFile <= -5 Then
MsgBox "Le fichier " & fname & " sera supprimé car créé le " & fdate
Else
MsgBox "Le fichier " & fname & " ne sera pas supprimé car créé le " & fdate
End If
Set f = Nothing
Set fso = Nothing
C'était une erreur de saisie dans cet exemple, mais dans mon code
à un certain endroit, je définis le chemin dos des fichiers (shortPath.Name)
d'où ma variable strPath.
Il faut remplacer strPath
Path correspond à "c:" par ex.
Ex pour un fichier.
jean-marc
Dim Fichier
Fichier = "d:\test.txt"
Dim fso, Dossiers, f, fdate, fname, dtDiffFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(Fichier)
fdate = f.DateLastModified
fname = f.Name
dtDiffFile = DateDiff("d", Now, fdate)
If dtDiffFile <= -5 Then
MsgBox "Le fichier " & fname & " sera supprimé car créé le " & fdate
Else
MsgBox "Le fichier " & fname & " ne sera pas supprimé car créé le " & fdate
End If
Set f = Nothing
Set fso = Nothing
DEEP_R
Messages postés
11
Date d'inscription
jeudi 21 septembre 2006
Statut
Membre
Dernière intervention
30 octobre 2006
5 oct. 2006 à 10:02
5 oct. 2006 à 10:02
bonjour,
voila, jai suivi vos conseils et franchement cela m'a bien aidé, merci! je suis presque a bot de mon programme, jai complété le script mqis comme dab un petit pépin, cette fois ci a la fin du prog, surement un syntaxe oublié mais jarrive pas a le trouver.
jai copié l'exemple ci dessous, regardez si cest possible de le copier et l'executer en vbs et me faire savoir si jamais vous trouvez l'erreur. le but de ce script cest de comparer deux fichiers, un sur le serveur et l'autre sur un ordi "client". si la date du fichier sur le client nest pas mis a jours comparé avec la date du fichier sur le serveur, je dois coper le fichier se trouvant sur le serveur vers le client. sinon il sera pas copié. je pense qu'en regardant mon script, vous aurez une idée de mon objectif.
merci pour votre aide! Rakesh.
Dim Path
Path = " C:\intouch\machine\emballeuse\P1 "
MsgBox ShowFolderList(" C:\outils "),vbmessage," Fichiers présents dans le répertoire "
Function ShowFolderList(strpath)
Dim fso, Dossiers1, dossiers2, fic1, fic2, fichiers,fichiers2, strListe, f1, f2, fdate1, fdate2, fname, dtDiffFile1, dtDiffFile2
Set fso = CreateObject("Scripting.FileSystemObject") ' SERVEUR'
Set Dossiers1 = fso.GetFolder("C:\intouch\machine\emballeuse\P1") ' SERVEUR'
Set fic1 = Dossiers1.Files ' SERVEUR'
For Each fichiers in fic1
Set f1 = fso.GetFolder("C:\intouch\machine\emballeuse\P1 ")
fdate1 = f.DateLastModified
fname1 = f.Name
dtDiffFile1 = DateDiff("d", Now, fdate1)
set fso = createobject("scripting.filesystemobject") ' CLIENT '
set dossiers2 = fso.GetFolder("C:\EMS") ' CLIENT '
set fic2 = dossiers2.files ' CLIENT '
For each fichiers2 in fic2
set f2 = fso.GetFolder("C:\EMS")
fdate2 = f.DateLastModified
fname2 = F.name
dtDiffFile2 = DateDiff("d", fdate1, fdate2)
If dtDiffFile2 <= dtDiffFile1 Then
MsgBox " Le fichier " & Path & fname2 & " sera restauré car a été crée le " & fdate2
Dim FSys, Monfic
Set Fsys = CreateObject("Scripting.FileSystemObject")
Set Monfic = FSys.Getfolder("C:\EMS")
Monfic.Copy "C:\intouch\machine\emballeuse\P1 ", True
Msgbox "fichier copié"
Else
MsgBox " Le fichier " & Path & fname2 & " ne sera pas restauré car il n'est pas à jour " & fdate2
End If
strListe = strListe & vbcrlf & vbcrlf & fname & " - date de modif: " & fdate1
Next
ShowFolderList = strListe
End Function
voila, jai suivi vos conseils et franchement cela m'a bien aidé, merci! je suis presque a bot de mon programme, jai complété le script mqis comme dab un petit pépin, cette fois ci a la fin du prog, surement un syntaxe oublié mais jarrive pas a le trouver.
jai copié l'exemple ci dessous, regardez si cest possible de le copier et l'executer en vbs et me faire savoir si jamais vous trouvez l'erreur. le but de ce script cest de comparer deux fichiers, un sur le serveur et l'autre sur un ordi "client". si la date du fichier sur le client nest pas mis a jours comparé avec la date du fichier sur le serveur, je dois coper le fichier se trouvant sur le serveur vers le client. sinon il sera pas copié. je pense qu'en regardant mon script, vous aurez une idée de mon objectif.
merci pour votre aide! Rakesh.
Dim Path
Path = " C:\intouch\machine\emballeuse\P1 "
MsgBox ShowFolderList(" C:\outils "),vbmessage," Fichiers présents dans le répertoire "
Function ShowFolderList(strpath)
Dim fso, Dossiers1, dossiers2, fic1, fic2, fichiers,fichiers2, strListe, f1, f2, fdate1, fdate2, fname, dtDiffFile1, dtDiffFile2
Set fso = CreateObject("Scripting.FileSystemObject") ' SERVEUR'
Set Dossiers1 = fso.GetFolder("C:\intouch\machine\emballeuse\P1") ' SERVEUR'
Set fic1 = Dossiers1.Files ' SERVEUR'
For Each fichiers in fic1
Set f1 = fso.GetFolder("C:\intouch\machine\emballeuse\P1 ")
fdate1 = f.DateLastModified
fname1 = f.Name
dtDiffFile1 = DateDiff("d", Now, fdate1)
set fso = createobject("scripting.filesystemobject") ' CLIENT '
set dossiers2 = fso.GetFolder("C:\EMS") ' CLIENT '
set fic2 = dossiers2.files ' CLIENT '
For each fichiers2 in fic2
set f2 = fso.GetFolder("C:\EMS")
fdate2 = f.DateLastModified
fname2 = F.name
dtDiffFile2 = DateDiff("d", fdate1, fdate2)
If dtDiffFile2 <= dtDiffFile1 Then
MsgBox " Le fichier " & Path & fname2 & " sera restauré car a été crée le " & fdate2
Dim FSys, Monfic
Set Fsys = CreateObject("Scripting.FileSystemObject")
Set Monfic = FSys.Getfolder("C:\EMS")
Monfic.Copy "C:\intouch\machine\emballeuse\P1 ", True
Msgbox "fichier copié"
Else
MsgBox " Le fichier " & Path & fname2 & " ne sera pas restauré car il n'est pas à jour " & fdate2
End If
strListe = strListe & vbcrlf & vbcrlf & fname & " - date de modif: " & fdate1
Next
ShowFolderList = strListe
End Function
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
27
5 oct. 2006 à 21:20
5 oct. 2006 à 21:20
Bonsoir à tous,
Bonsoir 863964 DEEP_R=863964 DEEP_R
Ayant constaté plusieurs incohérences dans ton code, j'ai préféré le réécrire.
J'ai laissé en commentaires les "Msgbox" qui permettent de vérifier les variables.
@+.
jean-marc
Option explicit
Const Path_Server = "D:\test\Path_Server"
Const Path_Client = "D:\test\Path_Client"
Call Compare_Client_Server()
Function Compare_Client_Server()
Dim Fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim Dossier_Client : Set Dossier_Client = Fso.GetFolder(Path_Client)
Dim Files_Client : Set Files_Client = Dossier_Client.Files
Dim Fichier_Client
'Récupération du nom de File_Client sur Path_Client et de sa dernière date de modification
For Each Fichier_Client in Files_Client
Dim File_Client : File_Client = Fichier_Client.Name
Dim Date_Client : Date_Client = Fichier_Client.DateLastModified
'Vérification que "Path_Client & File_Client" existe sur Path_Server
Call Compare_File(File_Client, Date_Client)
Next
Set Fso = Nothing
Set Dossier_Client = Nothing
Set Files_Client = Nothing
MsgBox "script terminé"
End Function
Function Compare_File(File_Client, Date_Client)
'Vérification que File_Client existe sur Path_Server
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
If Fso.FileExists(Path_Server & File_Client) Then Call Compare_Date(File_Client, Date_Client)
Set Fso = Nothing
End function
Function Compare_Date(File_Client, Date_Client)
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
'Vérification que le fichier existe sur le Path_Server
If Fso.FileExists(Fso.GetFile(Path_Server & File_Client)) Then
'La différence de date est effectuée en minute
Dim dtDiffFile
dtDiffFile = DateDiff("n" , Date_Client, Fso.GetFile(Path_Server & File_Client).DateLastModified)
'Si la date de dernière modification de File_Client
'est < à la date de dernière modification de File_Server => on copie File_Server sur File_Client
If dtDiffFile <= 1 Then
' MsgBox "fichier client: " & Path_Client & File_Client &vbCrLf& "DateLastModified: " & Date_Client &vbCrLf&vbCrLf&_
' "fichier server: " & Fso.GetFile(Path_Server & File_Client).Path & Fso.GetFile(Path_Server & File_Client).Name &vbCrLf& "DateLastModified: " & Fso.GetFile(Path_Server & File_Client).DateLastModified &vbCrLf&_
' "Différence entre les 2 dates: " &vbCrLf& dtDiffFile,,"Date_Client > Date_Server"
Else
' MsgBox "fichier client: " & Path_Client & File_Client &vbCrLf& "DateLastModified: " & Date_Client &vbCrLf&vbCrLf&_
' "fichier server: " & Fso.GetFile(Path_Server & File_Client).Path & Fso.GetFile(Path_Server & File_Client).Name &vbCrLf& "DateLastModified: " & Fso.GetFile(Path_Server & File_Client).DateLastModified &vbCrLf&_
' vbCrLf&vbCrLf&"Différence entre les 2 dates: " &vbCrLf& dtDiffFile,,"Date_Client =< Date_Server ### File_Server sera copié sur File_Client"
Call Copy_Server_Client(File_Client)
End If
End If
Set Fso = Nothing
End function
Function Copy_Server_Client(File_Client)
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
Fso.CopyFile Path_Server & File_Client, Path_Client & File_Client
Set Fso = Nothing
End function
Bonsoir 863964 DEEP_R=863964 DEEP_R
Ayant constaté plusieurs incohérences dans ton code, j'ai préféré le réécrire.
J'ai laissé en commentaires les "Msgbox" qui permettent de vérifier les variables.
@+.
jean-marc
Option explicit
Const Path_Server = "D:\test\Path_Server"
Const Path_Client = "D:\test\Path_Client"
Call Compare_Client_Server()
Function Compare_Client_Server()
Dim Fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim Dossier_Client : Set Dossier_Client = Fso.GetFolder(Path_Client)
Dim Files_Client : Set Files_Client = Dossier_Client.Files
Dim Fichier_Client
'Récupération du nom de File_Client sur Path_Client et de sa dernière date de modification
For Each Fichier_Client in Files_Client
Dim File_Client : File_Client = Fichier_Client.Name
Dim Date_Client : Date_Client = Fichier_Client.DateLastModified
'Vérification que "Path_Client & File_Client" existe sur Path_Server
Call Compare_File(File_Client, Date_Client)
Next
Set Fso = Nothing
Set Dossier_Client = Nothing
Set Files_Client = Nothing
MsgBox "script terminé"
End Function
Function Compare_File(File_Client, Date_Client)
'Vérification que File_Client existe sur Path_Server
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
If Fso.FileExists(Path_Server & File_Client) Then Call Compare_Date(File_Client, Date_Client)
Set Fso = Nothing
End function
Function Compare_Date(File_Client, Date_Client)
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
'Vérification que le fichier existe sur le Path_Server
If Fso.FileExists(Fso.GetFile(Path_Server & File_Client)) Then
'La différence de date est effectuée en minute
Dim dtDiffFile
dtDiffFile = DateDiff("n" , Date_Client, Fso.GetFile(Path_Server & File_Client).DateLastModified)
'Si la date de dernière modification de File_Client
'est < à la date de dernière modification de File_Server => on copie File_Server sur File_Client
If dtDiffFile <= 1 Then
' MsgBox "fichier client: " & Path_Client & File_Client &vbCrLf& "DateLastModified: " & Date_Client &vbCrLf&vbCrLf&_
' "fichier server: " & Fso.GetFile(Path_Server & File_Client).Path & Fso.GetFile(Path_Server & File_Client).Name &vbCrLf& "DateLastModified: " & Fso.GetFile(Path_Server & File_Client).DateLastModified &vbCrLf&_
' "Différence entre les 2 dates: " &vbCrLf& dtDiffFile,,"Date_Client > Date_Server"
Else
' MsgBox "fichier client: " & Path_Client & File_Client &vbCrLf& "DateLastModified: " & Date_Client &vbCrLf&vbCrLf&_
' "fichier server: " & Fso.GetFile(Path_Server & File_Client).Path & Fso.GetFile(Path_Server & File_Client).Name &vbCrLf& "DateLastModified: " & Fso.GetFile(Path_Server & File_Client).DateLastModified &vbCrLf&_
' vbCrLf&vbCrLf&"Différence entre les 2 dates: " &vbCrLf& dtDiffFile,,"Date_Client =< Date_Server ### File_Server sera copié sur File_Client"
Call Copy_Server_Client(File_Client)
End If
End If
Set Fso = Nothing
End function
Function Copy_Server_Client(File_Client)
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
Fso.CopyFile Path_Server & File_Client, Path_Client & File_Client
Set Fso = Nothing
End function
DEEP_R
Messages postés
11
Date d'inscription
jeudi 21 septembre 2006
Statut
Membre
Dernière intervention
30 octobre 2006
6 oct. 2006 à 17:05
6 oct. 2006 à 17:05
bonjour jean marc,
merci une fois de plus, la solution que vous mavez apporté est vraiment interessant mais toutefois, il y quelques codes que je narrive pas a comprendre, biensur, etant donné que je suis débutant! ce serait vraiment gentil de votre part si seulement vous pouviez m'eclaircir sur ces quelques lignes " en rouge" s'il vous plait.
Function Compare_File(File_Client, Date_Client)
If Fso.FileExists(Fso.GetFile(Path_Server & File_Client)) Then
'je dois remplacé ces fonctions en rouge par un dossier et sa date ou je les laisse?'
quand jai executé le programme, il a marché mais a moitié seulement, c-a-d jai eu le message "script terminé" seulement. puis jai rien comme message. jai surement omis quelque chose. je vous envois le script, dites moi si quelque chose y manque, un dossier ou repertoire non défini.
Function Compare_Client_Server()
Dim Fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim Dossier_Client : Set Dossier_Client = Fso.GetFolder("C:\test\desti")
Dim Files_Client : Set Files_Client = Dossier_Client.Files
Dim Fichier_Client
'Récupération du nom de File_Client sur Path_Client et de sa dernière date de modification
For Each Fichier_Client in Files_Client
Dim File_Client : File_Client = Fichier_Client.Name
Dim Date_Client : Date_Client = Fichier_Client.DateLastModified
'Vérification que "Path_Client & File_Client" existe sur Path_Server
Call Compare_File(File_Client, Date_Client)
Next
Set Fso = Nothing
Set Dossier_Client = Nothing
Set Files_Client = Nothing
MsgBox "script terminé"
End Function
Function Compare_File(File_Client, Date_Client)
'Vérification que File_Client existe sur Path_Server
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
If Fso.FileExists(Path_Server & File_Client) Then Call Compare_Date(File_Client, Date_Client)
Set Fso = Nothing
End function
Function Compare_Date(File_Client, Date_Client)
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
'Vérification que le fichier existe sur le Path_Server
If Fso.FileExists(Fso.GetFile(Path_Server & File_Client)) Then
'La différence de date est effectuée en minute
Dim dtDiffFile
dtDiffFile = DateDiff("n" , Date_Client, Fso.GetFile(Path_Server & File_Client).DateLastModified)
'Si la date de dernière modification de File_Client
'est < à la date de dernière modification de File_Server => on copie File_Server sur File_Client
If dtDiffFile <= 1 Then
MsgBox "fichier client: " & Path_Client & File_Client &vbCrLf& "DateLastModified: " & Date_Client &vbCrLf&vbCrLf&_
"fichier server: " & Fso.GetFile(Path_Server & File_Client).Path & Fso.GetFile(Path_Server & File_Client).Name &vbCrLf& "DateLastModified: " & Fso.GetFile(Path_Server & File_Client).DateLastModified &vbCrLf&_
"Différence entre les 2 dates: " &vbCrLf& dtDiffFile,,"Date_Client > Date_Server"
Else
MsgBox "fichier client: " & Path_Client & File_Client &vbCrLf& "DateLastModified: " & Date_Client &vbCrLf&vbCrLf&_
"fichier server: " & Fso.GetFile(Path_Server & File_Client).Path & Fso.GetFile(Path_Server & File_Client).Name &vbCrLf& "DateLastModified: " & Fso.GetFile(Path_Server & File_Client).DateLastModified &vbCrLf&_
vbCrLf&vbCrLf&"Différence entre les 2 dates: " &vbCrLf& dtDiffFile,,"Date_Client =< Date_Server ### File_Server sera copié sur File_Client"
Call Copy_Server_Client(File_Client)
End If
End If
Set Fso = Nothing
End function
Function Copy_Server_Client(File_Client)
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
Fso.CopyFile Path_Server & File_Client, Path_Client & File_Client
Set Fso = Nothing
End function
merci beaucoup!
merci une fois de plus, la solution que vous mavez apporté est vraiment interessant mais toutefois, il y quelques codes que je narrive pas a comprendre, biensur, etant donné que je suis débutant! ce serait vraiment gentil de votre part si seulement vous pouviez m'eclaircir sur ces quelques lignes " en rouge" s'il vous plait.
Function Compare_File(File_Client, Date_Client)
If Fso.FileExists(Fso.GetFile(Path_Server & File_Client)) Then
'je dois remplacé ces fonctions en rouge par un dossier et sa date ou je les laisse?'
quand jai executé le programme, il a marché mais a moitié seulement, c-a-d jai eu le message "script terminé" seulement. puis jai rien comme message. jai surement omis quelque chose. je vous envois le script, dites moi si quelque chose y manque, un dossier ou repertoire non défini.
Function Compare_Client_Server()
Dim Fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim Dossier_Client : Set Dossier_Client = Fso.GetFolder("C:\test\desti")
Dim Files_Client : Set Files_Client = Dossier_Client.Files
Dim Fichier_Client
'Récupération du nom de File_Client sur Path_Client et de sa dernière date de modification
For Each Fichier_Client in Files_Client
Dim File_Client : File_Client = Fichier_Client.Name
Dim Date_Client : Date_Client = Fichier_Client.DateLastModified
'Vérification que "Path_Client & File_Client" existe sur Path_Server
Call Compare_File(File_Client, Date_Client)
Next
Set Fso = Nothing
Set Dossier_Client = Nothing
Set Files_Client = Nothing
MsgBox "script terminé"
End Function
Function Compare_File(File_Client, Date_Client)
'Vérification que File_Client existe sur Path_Server
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
If Fso.FileExists(Path_Server & File_Client) Then Call Compare_Date(File_Client, Date_Client)
Set Fso = Nothing
End function
Function Compare_Date(File_Client, Date_Client)
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
'Vérification que le fichier existe sur le Path_Server
If Fso.FileExists(Fso.GetFile(Path_Server & File_Client)) Then
'La différence de date est effectuée en minute
Dim dtDiffFile
dtDiffFile = DateDiff("n" , Date_Client, Fso.GetFile(Path_Server & File_Client).DateLastModified)
'Si la date de dernière modification de File_Client
'est < à la date de dernière modification de File_Server => on copie File_Server sur File_Client
If dtDiffFile <= 1 Then
MsgBox "fichier client: " & Path_Client & File_Client &vbCrLf& "DateLastModified: " & Date_Client &vbCrLf&vbCrLf&_
"fichier server: " & Fso.GetFile(Path_Server & File_Client).Path & Fso.GetFile(Path_Server & File_Client).Name &vbCrLf& "DateLastModified: " & Fso.GetFile(Path_Server & File_Client).DateLastModified &vbCrLf&_
"Différence entre les 2 dates: " &vbCrLf& dtDiffFile,,"Date_Client > Date_Server"
Else
MsgBox "fichier client: " & Path_Client & File_Client &vbCrLf& "DateLastModified: " & Date_Client &vbCrLf&vbCrLf&_
"fichier server: " & Fso.GetFile(Path_Server & File_Client).Path & Fso.GetFile(Path_Server & File_Client).Name &vbCrLf& "DateLastModified: " & Fso.GetFile(Path_Server & File_Client).DateLastModified &vbCrLf&_
vbCrLf&vbCrLf&"Différence entre les 2 dates: " &vbCrLf& dtDiffFile,,"Date_Client =< Date_Server ### File_Server sera copié sur File_Client"
Call Copy_Server_Client(File_Client)
End If
End If
Set Fso = Nothing
End function
Function Copy_Server_Client(File_Client)
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
Fso.CopyFile Path_Server & File_Client, Path_Client & File_Client
Set Fso = Nothing
End function
merci beaucoup!
cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
27
7 oct. 2006 à 09:51
7 oct. 2006 à 09:51
Bonjour à tous....
Bonjour 863964 DEEP_R
File_Client est une variable chargée par "Dim File_Client : File_Client = Fichier_Client.Name"
File_Client contient par exemple "test.txt"
Date_Client est une variable chargée par "Dim Date_Client : Date_Client = Fichier_Client.DateLastModified
Date_Client continet par exemple "05/10/2006 20:10:05"
Pour visualiser les variables, il suffit de rajouter
MsgBox File_Client &vbCrLf& Date_Client
Il y 2 constantes:
Const Path_Server = " D:\test\Path_Server\ "
Const Path_Client = "D:\test\Path_Client\"
Les constantes sont récupérables par toutes les fonctions,
contrairement aux variables qu'il faut transporter de function en function.
Dans ce script, ce sont les 2 seuls éléments à modifier.
Pour tes tests, il suffit de :
- créér 2 répertoires, modifier le contenudes 2 constantes;
- copier 1 fichier quelconque dans ces 2 répertoires;
- ouvrir et enregistrer le fichier qui est dans Path_Server;
- lancer le script.
La date de dernière modification du fichier qui est dans ton
répertoire Path_Server étant supérieure à celle du fichier
qui se trouve dans le répertoire "Path_Client",
le "Path_Server & File" se recopié sur "Path_Client & File".
Il n'y a pas + simple !!!
Espérant avoir été "plus clair".
Ce script a été testé.
jean-marc
Ci-dessous le code allégé de quelques msgbox = ajout de commentaires
'en vb6, rajouter:
'Sub .....OnClick...
Const Path_Server = "D:\test\Path_Server"
Const Path_Client = "D:\test\Path_Client"
Call Compare_Client_Server()
'End Sub
Function Compare_Client_Server()
Dim Fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim Dossier_Client : Set Dossier_Client = Fso.GetFolder(Path_Client)
Dim Files_Client : Set Files_Client = Dossier_Client.Files
Dim Fichier_Client
'Récupération du nom de File_Client sur Path_Client et de sa dernière date de modification
'Pour chaque Fichier_Client on va activer "Call Compare_File(File_Client, Date_Client)"
For Each Fichier_Client in Files_Client
Dim File_Client : File_Client = Fichier_Client.Name
Dim Date_Client : Date_Client = Fichier_Client.DateLastModified
MsgBox File_Client &vbCrLf& Date_Client,,"Nom du File_Client et sa date de dernière modification"
'On appelle la fonction ci-dessous avec comme
'variables ("test.txt","05/10/2006 20:10:05"
Call Compare_File(File_Client, Date_Client)
Next
Set Fso = Nothing
Set Dossier_Client = Nothing
Set Files_Client = Nothing
MsgBox "script terminé"
End Function
Function Compare_File(File_Client, Date_Client)
'Vérification que File_Client existe sur Path_Server
'Si le fichier "Path_Client & File_Client" n'existe pas sur
'"Path_Server", on ne fait rien. On sort donc de la
'fonction et on retourne à "For Each Fichier_Client" pour
'lire le fichier suivant
'
'Si le fichier existe sur "Path_Server, on active
'la fonction "Call Compare_Date(File_Client, Date_Client)"
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
If Fso.FileExists(Path_Server & File_Client) Then
Call Compare_Date(File_Client, Date_Client)
End If
Set Fso = Nothing
End function
Function Compare_Date(File_Client, Date_Client)
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
'Vérification que le fichier existe sur le Path_Server
If Fso.FileExists(Fso.GetFile(Path_Server & File_Client)) Then
'La différence de date est effectuée en minute
Dim dtDiffFile
dtDiffFile = DateDiff("n" , Date_Client, Fso.GetFile(Path_Server &_
File_Client).DateLastModified)
'Si la date de dernière modification de File_Client
'est < à la date de dernière modification de File_Server
'=> on copie File_Server sur File_Client
If dtDiffFile <= 1 Then
Else
Call Copy_Server_Client(File_Client)
End If
End If
Set Fso = Nothing
End function
Function Copy_Server_Client(File_Client)
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
Fso.CopyFile Path_Server & File_Client, Path_Client & File_Client
Set Fso = Nothing
End function
Bonjour 863964 DEEP_R
File_Client est une variable chargée par "Dim File_Client : File_Client = Fichier_Client.Name"
File_Client contient par exemple "test.txt"
Date_Client est une variable chargée par "Dim Date_Client : Date_Client = Fichier_Client.DateLastModified
Date_Client continet par exemple "05/10/2006 20:10:05"
Pour visualiser les variables, il suffit de rajouter
MsgBox File_Client &vbCrLf& Date_Client
Il y 2 constantes:
Const Path_Server = " D:\test\Path_Server\ "
Const Path_Client = "D:\test\Path_Client\"
Les constantes sont récupérables par toutes les fonctions,
contrairement aux variables qu'il faut transporter de function en function.
Dans ce script, ce sont les 2 seuls éléments à modifier.
Pour tes tests, il suffit de :
- créér 2 répertoires, modifier le contenudes 2 constantes;
- copier 1 fichier quelconque dans ces 2 répertoires;
- ouvrir et enregistrer le fichier qui est dans Path_Server;
- lancer le script.
La date de dernière modification du fichier qui est dans ton
répertoire Path_Server étant supérieure à celle du fichier
qui se trouve dans le répertoire "Path_Client",
le "Path_Server & File" se recopié sur "Path_Client & File".
Il n'y a pas + simple !!!
Espérant avoir été "plus clair".
Ce script a été testé.
jean-marc
Ci-dessous le code allégé de quelques msgbox = ajout de commentaires
'en vb6, rajouter:
'Sub .....OnClick...
Const Path_Server = "D:\test\Path_Server"
Const Path_Client = "D:\test\Path_Client"
Call Compare_Client_Server()
'End Sub
Function Compare_Client_Server()
Dim Fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim Dossier_Client : Set Dossier_Client = Fso.GetFolder(Path_Client)
Dim Files_Client : Set Files_Client = Dossier_Client.Files
Dim Fichier_Client
'Récupération du nom de File_Client sur Path_Client et de sa dernière date de modification
'Pour chaque Fichier_Client on va activer "Call Compare_File(File_Client, Date_Client)"
For Each Fichier_Client in Files_Client
Dim File_Client : File_Client = Fichier_Client.Name
Dim Date_Client : Date_Client = Fichier_Client.DateLastModified
MsgBox File_Client &vbCrLf& Date_Client,,"Nom du File_Client et sa date de dernière modification"
'On appelle la fonction ci-dessous avec comme
'variables ("test.txt","05/10/2006 20:10:05"
Call Compare_File(File_Client, Date_Client)
Next
Set Fso = Nothing
Set Dossier_Client = Nothing
Set Files_Client = Nothing
MsgBox "script terminé"
End Function
Function Compare_File(File_Client, Date_Client)
'Vérification que File_Client existe sur Path_Server
'Si le fichier "Path_Client & File_Client" n'existe pas sur
'"Path_Server", on ne fait rien. On sort donc de la
'fonction et on retourne à "For Each Fichier_Client" pour
'lire le fichier suivant
'
'Si le fichier existe sur "Path_Server, on active
'la fonction "Call Compare_Date(File_Client, Date_Client)"
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
If Fso.FileExists(Path_Server & File_Client) Then
Call Compare_Date(File_Client, Date_Client)
End If
Set Fso = Nothing
End function
Function Compare_Date(File_Client, Date_Client)
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
'Vérification que le fichier existe sur le Path_Server
If Fso.FileExists(Fso.GetFile(Path_Server & File_Client)) Then
'La différence de date est effectuée en minute
Dim dtDiffFile
dtDiffFile = DateDiff("n" , Date_Client, Fso.GetFile(Path_Server &_
File_Client).DateLastModified)
'Si la date de dernière modification de File_Client
'est < à la date de dernière modification de File_Server
'=> on copie File_Server sur File_Client
If dtDiffFile <= 1 Then
Else
Call Copy_Server_Client(File_Client)
End If
End If
Set Fso = Nothing
End function
Function Copy_Server_Client(File_Client)
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
Fso.CopyFile Path_Server & File_Client, Path_Client & File_Client
Set Fso = Nothing
End function
