Comparer des fichiers sur vbs [Résolu]

Messages postés
11
Date d'inscription
jeudi 21 septembre 2006
Dernière intervention
30 octobre 2006
- 27 sept. 2006 à 08:41 - Dernière réponse :
Messages postés
1855
Date d'inscription
jeudi 23 mai 2002
Dernière intervention
24 juin 2018
- 7 oct. 2006 à 09:51
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.
Afficher la suite 

Votre réponse

7 réponses

Meilleure réponse
Messages postés
1855
Date d'inscription
jeudi 23 mai 2002
Dernière intervention
24 juin 2018
- 27 sept. 2006 à 10:10
3
Merci
 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

Merci cs_JMO 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 86 internautes ce mois-ci

Commenter la réponse de cs_JMO
Messages postés
11
Date d'inscription
jeudi 21 septembre 2006
Dernière intervention
30 octobre 2006
- 3 oct. 2006 à 17:44
0
Merci
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!
Commenter la réponse de DEEP_R
Messages postés
1855
Date d'inscription
jeudi 23 mai 2002
Dernière intervention
24 juin 2018
- 3 oct. 2006 à 18:09
0
Merci
 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
Commenter la réponse de cs_JMO
Messages postés
11
Date d'inscription
jeudi 21 septembre 2006
Dernière intervention
30 octobre 2006
- 5 oct. 2006 à 10:02
0
Merci
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
 
Commenter la réponse de DEEP_R
Messages postés
1855
Date d'inscription
jeudi 23 mai 2002
Dernière intervention
24 juin 2018
- 5 oct. 2006 à 21:20
0
Merci
 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
Commenter la réponse de cs_JMO
Messages postés
11
Date d'inscription
jeudi 21 septembre 2006
Dernière intervention
30 octobre 2006
- 6 oct. 2006 à 17:05
0
Merci
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!
Commenter la réponse de DEEP_R
Messages postés
1855
Date d'inscription
jeudi 23 mai 2002
Dernière intervention
24 juin 2018
- 7 oct. 2006 à 09:51
0
Merci
 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
Commenter la réponse de cs_JMO

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.