Recuperer date et heure dans cellules

350dr

XLDnaute Junior
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.
 

Pièces jointes

  • Récup Date-Heure.xls
    142.5 KB · Affichages: 74
  • Récup Date-Heure.xls
    142.5 KB · Affichages: 69
  • Récup Date-Heure.xls
    142.5 KB · Affichages: 74

350dr

XLDnaute Junior
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

XLDnaute Barbatruc
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

XLDnaute Junior
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
 

Pièces jointes

  • Récup Date-Heure.xls
    142.5 KB · Affichages: 48
  • Récup Date-Heure.xls
    142.5 KB · Affichages: 50
  • Récup Date-Heure.xls
    142.5 KB · Affichages: 56

350dr

XLDnaute Junior
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 ?
 

Pièces jointes

  • SuiviFichiers.xls
    21.5 KB · Affichages: 48
  • SuiviFichiers.xls
    21.5 KB · Affichages: 50
  • SuiviFichiers.xls
    21.5 KB · Affichages: 49

JCGL

XLDnaute Barbatruc
Re : Recuperer date et heure dans cellules

Bonjour à tous,

Peux-tu essayer :

VB:
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

XLDnaute Junior
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

XLDnaute Junior
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
 
Dernière édition:
C

Compte Supprimé 979

Guest
Re : Recuperer date et heure dans cellules

Bonjour 350dr
Salut l'ami JC ;) :)

Essaye comme ceci
Code:
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

XLDnaute Junior
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 !
 
C

Compte Supprimé 979

Guest
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é ;)
Code:
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+
 

Discussions similaires

Réponses
5
Affichages
554

Statistiques des forums

Discussions
311 724
Messages
2 081 938
Membres
101 844
dernier inscrit
pktla