comparer des fichiers sur vbs Résolu

Question

bonjour a tous et toutes!

mon probleme cest que jarrive pas a ecrire un programme en vbscript pour comparer la date dun fichier et le jour meme de la comparaison.

la situation est comme telle:

je dois mettre a jour mes fichiers dun logiciel quelquonque sur mon portable branché sur le reseau, un petit logiciel doit pouvoir ragarder si mes fichiers en question sur le portable sont a jour comparé avec ceux sur le serveur, sils ne le sont pas, alors ce logiciel devra aller purger ceux qui sont a jour sur le serveur.

cs_JMO · Accepted Answer

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

DEEP_R · Answer

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!

cs_JMO · Answer

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:	est.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 · Answer

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

cs_JMO · Answer

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: est\Path_Server" Const Path_Client = "D: est\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 · Answer

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: est\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 · Answer

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:	est\Path_Server\ "            
Const Path_Client   = "D:	est\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:	est\Path_Server"            
Const Path_Client  = "D:	est\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

Comparer des fichiers sur vbs

7 réponses

Votre réponse

Discussions similaires