Recuperer date et heure dans cellules

[350dr]

Bonjour à tous,
Je souhaiterais récupérer dans des cellules la date et l’heure de création d’un fichier ouvert à l’aide d’une macro.
J’ai lu plusieurs posts à ce sujet mais je patauge totalement.
J’en appelle à vos connaissances pour m’aider.
Je donne plus d’explications dans le fichier joint.
Avec mes remerciements.

 

[350dr]

Re : Recuperer date et heure dans cellules

Un petit up.
Merci de votre aide

 

[JCGL]

Re : Recuperer date et heure dans cellules

Bonjour à tous,

Le projet VBA semble protégé par un mot de passe.

A + à tous

 

[350dr]

Re : Recuperer date et heure dans cellules

Bonjour JCGL

Il le sera mais pour l'instant j'ai mis la code en commentaire donc il n'est pas bloquant.
Si tu as un message "pas de fichier" c'est normal car le projet fait référence à un répertoire que tu n'as pas sur ton PC.
Merci de t'intéresser à mon problème.

 

[JCGL]

Re : Recuperer date et heure dans cellules

Bonjour à tous,

Le projet VBA semble protégé par un mot de passe pour la modification... Le projet est affichable mais je ne peux pas accéder au code.

A + à tous​

 

[350dr]

Re : Recuperer date et heure dans cellules

Bonjour
Bizard, chez moi je peux l’ouvrir sans mot de passe. Je n’ai pas de MdP dans Outil – Propriétés de VBAProject – Protection
Je le reposte.
Sinon essaie "manu727" pour voir !
Merci

 

[350dr]

Re : Recuperer date et heure dans cellules

Bonjour JCGL, le forum.
Après moultes recherches, j'ai trouvé un fichier posté par "Camarchepas" qui me convient à un détaille près:

Sub AfficheInfoAccesFichier()
Dim fs, f, s
Set fs = CreateObject("Scripting.FileSystemObject")
For T = 0 To 4
Chemin = Range("B3").Offset(0, T)
Fichier = Range("B3").Offset(1, T)
Complet = Chemin & "\" & Fichier
Set f = fs.GetFile(Complet)
Range("B3").Offset(2, T) = f.DateCreated
Range("B3").Offset(3, T) = f.DateLastModified
Range("B3").Offset(4, T) = f.DateLastAccessed

Next T
End Sub

J'ai adapté ce code à mon projet et ça marche nickel, mais le problème est que si l'un des fichier n'existe pas, je souhaite que la boucle passe au fichier suivant sans faire de modification.
Dans le fichier de "Camarchepas", si pas de fichier =>erreur fichier introuvable.
Ca fait 2 jours que je cherche une solution mais sans résultat.
Pourriez vous m'aider SVP ?

 

[JCGL]

Re : Recuperer date et heure dans cellules

Bonjour à tous,

Peux-tu essayer :

Sub AfficheInfoAccesFichier()
    Dim fs, f, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    For T = 0 To 4
     Chemin = Range("B3").Offset(0, T)
     Fichier = Range("B3").Offset(1, T)
     Complet = Chemin & "\" & Fichier
     On Error Resume Next
     Set f = fs.GetFile(Complet)
      Range("B3").Offset(2, T) = f.DateCreated
      Range("B3").Offset(3, T) = f.DateLastModified
      Range("B3").Offset(4, T) = f.DateLastAccessed


    Next T
End Sub

A + à tous

 

[350dr]

Re : Recuperer date et heure dans cellules

Merci JCGL pour ta réponse super rapide.
"On Error Resume Next" fonctionne partiellement :

L’instruction remplit bien sont rôle pour éviter le message d’erreur si un fichier n’existe pas.
Mais :
Si le fichier A.xls existe, dates de A ok
Si le fichier B.xls n’existe pas, les cellules prennent les dates du fichier A
Si le fichier C.xls existe, dates de C ok
Si le fichier D.xls n’existe pas, les cellules prennent les dates du fichier C
Etc ………
J’aimerai que les cellules de B et D ne soient pas modifiées si les fichiers n’existent pas.
J’ai recherché sur le forum avec les mots " saut de boucle ", " arrêt boucle ",… mais pas de résultat.
Merci de ton aide

 

[350dr]

Re : Recuperer date et heure dans cellules

Ne serait-il pas possible dans la boucle d'insérer un :
If T = "" Then 'Ne fait rien et continu avec T+1

Je n'ai malheureusement pas assé de connaissance en VBA pour trouver l'instruction qui me manque.
Merci

 

[350dr]

Re : Recuperer date et heure dans cellules

Un p'tit UP !
Une idée?
Merci

 

[350dr]

Re : Recuperer date et heure dans cellules

Bonjour à tous,
Je cherche désespérément solution à ce problème,
Qq’un a une idée ?
Merci de votre aide

 

[Compte Supprimé 979]

Re : Recuperer date et heure dans cellules

Bonjour 350dr
Salut l'ami JC 😉 🙂

Essaye comme ceci

Sub AfficheInfoAccesFichier()  Dim fs, f, s
  Set fs = CreateObject("Scripting.FileSystemObject")
  For T = 0 To 4
    Chemin = Range("B3").Offset(0, T)
    Fichier = Range("B3").Offset(1, T)
    Complet = Chemin & "\" & Fichier
    ' En cas d'erreur on continue l'exécution du code
    On Error Resume Next
    Set f = fs.GetFile(Complet)
    ' Si il n'y pas d'erreur
    If Err.Number = 0 Then
      ' On inscrit les valeurs
      Range("B3").Offset(2, T) = f.DateCreated
      Range("B3").Offset(3, T) = f.DateLastModified
      Range("B3").Offset(4, T) = f.DateLastAccessed
    End If
  Next T
End Sub

A+

 

[350dr]

Re : Recuperer date et heure dans cellules

Bonjour BrunoM45 et merci de t'intéresser à mon problème.
Je viens de tester ta proposition mais ça ne change rien, dès qu’un fichier existe, les dates des suivants (s’ils n’existent pas) prennent la date de ce fichier.
Si tous les fichiers sont présents, pas de problème.
Il doit bien y avoir une instruction pour supprimer ce genre de désagrément !

 

[Compte Supprimé 979]

Re : Recuperer date et heure dans cellules

Salut 350dr

Désolé, je n'ai pas tout analyser comme il faut ...

Selon ta demande

J’aimerai que les cellules de B et D ne soient pas modifiées si les fichiers n’existent pas.​

​

voici le code corrigé et testé 😉

Sub AfficheInfoAccesFichier()
  Dim fs, f, s
  Set fs = CreateObject("Scripting.FileSystemObject")
  For T = 0 To 4
    Chemin = Range("B3").Offset(0, T)
    Fichier = Range("B3").Offset(1, T)
    Complet = Chemin & "\" & Fichier
    ' En cas d'erreur on continue l'exécution du code
    On Error Resume Next
    Set f = fs.GetFile(Complet)
    ' Si il n'y pas d'erreur
    If Not f Is Nothing Then
      ' On inscrit les valeurs
      Range("B3").Offset(2, T) = f.DateCreated
      Range("B3").Offset(3, T) = f.DateLastModified
      Range("B3").Offset(4, T) = f.DateLastAccessed
    End If
    Set f = Nothing
  Next T
End Sub

A+