XL 2019 Comparaison date modification de plusieurs fichiers

Fanrs

XLDnaute Nouveau
Bonjour à tous,

Je cherche, mais ne trouve pas chaussure à mon pied....

La possibilité en vba de comparer la date/heure de modification de 5 fichiers qui sont en dehors du dossier source

Le but avant d'actualiser tous les liens et de savoir si tous les fichiers ont la même date et heure (qu'il sont tous à jour)

Si date/heure fichier A = date/heure fichier B = date/heure fichier C = date/heure fichier D = date/heure fichier E alors call macro sinon msgbox

Et je me pose aussi la question de si les dates de ces fichiers sont à cheval sur l'heure pleine !

Merci d'avance
 
Solution
Exactement la même chose écrit différemment.
Vous mettez vos 5 fichiers et le nom du dossier, et la macro vous donné l'écart entre le plus ancien et le plus récent. Comme ce temps est un delta il n'y a pas de notion d'heure pleine puisque c'est l'écart qui est remonté.

VB:
Sub Essai()
Dim Rep, Fichier(5), DateFil(5), EcartMax
Rep = "C:\Users\PC_PAPA\Desktop\"
' Mettre les 5 fichiers en array
Fichier(1) = "Benford.xlsm"
Fichier(2) = "Benford2.xlsm"
Fichier(3) = "Benford3.xlsm"
Fichier(4) = "Classeur.xlsx"
Fichier(5) = "Classeur1.xlsm"
' Mémoristion des dernière dates des 5 fichiers
For i = 1 To 5
    DateFil(i) = FileDateTime(Rep & Fichier(i))
Next i
' Comparaison des dates et mémorisation plus vieux vs plus récent
EcartMax = 0
For i = 1...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Fanrs,
En PJ un essai. La macro liste les fichiers d'un dossier avec la date de dernière modification.
Je n'ai pas compris "à cheval sur l'heure pleine". Ici la date donnée est jour/mois/année/heure/minute donc devrait être suffisant. Il faudra cependant calculer sur une fourchette. On peut faire : Si DateMax-dateMin < xx min.

Dans l'état la macro liste les fichiers du bureau, mais il faut actualiser le chemin.
VB:
Sub ListingFichiers()
' Liste les fichiers présent dans Rep et les rentre dans la Liste.
' La liste commence à l'indice 1 pour faire plus simple ( donc Liste(0) est vide )
Dim Rep As String, Fichier As String, i As Integer, Liste(1000), DateFile(1000)
On Error GoTo Fin

' Déclaration du dossier concerné
Rep = "C:\Users\PC_PAPA\Desktop\"

' Index stockage et clear tableaux
i = 0
[FileListe].ClearContents
[DateCreationDir].ClearContents
' Vérifie si Rep se termine par \
If Right(Rep, 1) <> "\" Then Rep = Rep & "\"

Fichier = Dir(Rep)
Do While Fichier <> ""
    i = i + 1
    Liste(i) = Fichier
    DateFile(i) = Int(FileDateTime(Rep & Fichier)) ' Enregistre la date de création du fichier ( en type date )
    Fichier = Dir
    [FileListe].Cells(i, 1) = Fichier
    [DateCreationDir].Cells(i, 1) = FileDateTime(Rep & Fichier)
Loop
Fin:
End Sub
 

Pièces jointes

  • FileList.xlsm
    16.5 KB · Affichages: 15

Dudu2

XLDnaute Barbatruc
Bonjour,
VB:
Sub a()
    Dim Fso As Scripting.FileSystemObject
    Dim FileItem As Scripting.File
    Dim DateCreated As Date
    Dim DateLastModified As Date
    Dim Size As Long
    
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set FileItem = Fso.GetFile("H:\Téléchargements\2020-11-22_065452.jpg")
    
    DateCreated = FileItem.DateCreated
    DateLastModified = FileItem.DateLastModified
    Size = Left(FileItem.Size, 10)
    
    MsgBox "Date de création: " & DateCreated & vbCrLf & _
           "Date de modification: " & DateLastModified & vbCrLf & _
           "Taille du fichier: " & Size & "   octets"
    
End Sub
 

Fanrs

XLDnaute Nouveau
Merci pour vos réponses aussi rapide ;)

@Dudu2 je suis très loin d'être développeur, mais on en apprend tous les jours ! et le code que tu me propose me fais l'erreur de compilation => type défini par l'utilisateur on définit

@sylvanu merci pour ta proposition, le code fonctionne

En revanche, cela ne correspond qu'a moitié à ma demande, car il faut vraiment que cela cible LES 5 fichiers et non le dossier (car plein d'autre chose dedans) de plus il me faudrait le code de comparaison qui découlerait si vrai vers l'exécution d'une autre macro et si faut vers une msgbox qui propose de retélécharger les fichiers

Désolé si ta proposition est une orientation vers la solution que je demande, mais je ne suis qu'un débutant et ne vois pas la finalité

Si date/heure fichier A = date/heure fichier B = date/heure fichier C = date/heure fichier D = date/heure fichier E alors call macro sinon msgbox

Je n'ai pas compris "à cheval sur l'heure pleine".

Ben si je veux faire la comparaison à l'heure, il va se poser un problème si les fichiers ont une heure de modification sur l'heure pleine

par exemple :
-fichier 1 => 11h58
-fichier 2 => 11h59
-Fichier 3 => 12h02

On a 11h et 12h


Le but final de ma demande :

Un soft télécharge de listes d'un base de données, je le récupère via données externe pour les traiter dans mon tableur. Mais il s'avère que des fois une liste n'ai pas télécharger !

Donc je voudrais, avant de lancer ma macro pour actualiser les donnés, vérifier si toutes les listes ont étés télécharger en comparant leurs dates de dernière modification si vrai lancement de l'actualisation des données et si faux message qui propose de retélécharger les listes !
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Exactement la même chose écrit différemment.
Vous mettez vos 5 fichiers et le nom du dossier, et la macro vous donné l'écart entre le plus ancien et le plus récent. Comme ce temps est un delta il n'y a pas de notion d'heure pleine puisque c'est l'écart qui est remonté.

VB:
Sub Essai()
Dim Rep, Fichier(5), DateFil(5), EcartMax
Rep = "C:\Users\PC_PAPA\Desktop\"
' Mettre les 5 fichiers en array
Fichier(1) = "Benford.xlsm"
Fichier(2) = "Benford2.xlsm"
Fichier(3) = "Benford3.xlsm"
Fichier(4) = "Classeur.xlsx"
Fichier(5) = "Classeur1.xlsm"
' Mémoristion des dernière dates des 5 fichiers
For i = 1 To 5
    DateFil(i) = FileDateTime(Rep & Fichier(i))
Next i
' Comparaison des dates et mémorisation plus vieux vs plus récent
EcartMax = 0
For i = 1 To 5
    For j = i+1 To 5
        If Abs(DateFil(i) - DateFil(j)) > EcartMax Then
            EcartMax = Abs(DateFil(i) - DateFil(j))
        End If
    Next j
Next i
' Message de sortie
MsgBox "L'écart plus vieux plus récent est de : " & Format(EcartMax, "hh:mm:ss")
End Sub
:
 

Discussions similaires

Réponses
46
Affichages
646