Retrouver le fichier le plus récent
Bonjour le Forum,
J'aimerais à l'aide d'un code, pouvoir dans activeworkbook copier les deux " Sheet 1" des deux fichiers Excel les plus récents se trouvant dans un dossier donné. Ceci en vue de les comparer.
L'enregistreur de macro me donne le code pour copier coller mais je ne parviens pas à le forcer à prendre les 2 fichiers les plus récents dans le dossier donné.
Merci d'avance pour votre aide,
Bonjour,
Je viens de retrouver dans mes archives ce code à adapter ...
Function PlusRecent(ByVal Folder As String, ByVal Identi As String) As String
' Variable Identi sert à identifier les fichiers analysés
Dim FSO As Object
Dim f As Object
Dim DerDate As Date
Set FSO = CreateObject("Scripting.FileSystemObject")
On Error GoTo ExitPoint
For Each f In FSO.GetFolder(Folder).Files
If InStr(1, f.Name, Identi, 1) Then
If f.DateCreated > DerDate Then
DerDate = f.DateCreated
PlusRecent = f.Name
End If
End If
Next
ExitPoint:
End FunctionMerci James007.
J'ai de quoi commencer
Bonne journée !
Re,
Merci pour tes remerciements ...
Me revoilà,
Si quelqu'un peut compléter le code ça serait super.
J'arrive à ouvrir le dernier fichier en utilisant le code ci-dessous ... Reste à copier la sheet 1 dans activeworkbook et à faire la meme chose pour l'avant dernier message le plus recent et ça je ne trouve pas.
Sub test()
'Declare the variables
Dim MyPath As String
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date
'ton répertoir, à modifier en fonction de ce que tu veux
MyPath = "L:blabla\"
'Make sure that the path ends in a backslash
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
'Get the first Excel file from the folder
MyFile = Dir(MyPath & "*.xls", vbNormal)
'If no files were found, exit the sub
If Len(MyFile) = 0 Then
MsgBox "No files were found...", vbExclamation
Exit Sub
End If
'Loop through each Excel file in the folder
Do While Len(MyFile) > 0
'Assign the date/time of the current file to a variable
LMD = FileDateTime(MyPath & MyFile)
'If the date/time of the current file is greater than the latest
'recorded date, assign its filename and date/time to variables
If LMD > LatestDate Then
LatestFile = MyFile
LatestDate = LMD
End If
'Get the next Excel file from the folder
MyFile = Dir
Loop
'Open the latest file
Workbooks.Open MyPath & LatestFile
End Sub Merci d'avance,
Re,
Manifestement ... tu es passé à l'étape suivante ...
Je te conseille d'ouvrir un nouveau fil pour copier l'onglet ...
Je voulais le faire mais je n'ai toujours pas trouvé comme trouver l'avant dernier fichier dans le dossier donc je me suis dis que j'allais attendre ça avant de voir pour ouvrir un autre fil
Re,
Si tu veux identifier l'avant-dernier fichier dans le dossier ... trois petits conseils ...
1. Si une date peut faire partie des noms du fichiers ... tu pourrais te simplifier la vie ... sinon...
2. Il serait utile de filtrer tes fichiers par un identifiant spécifique...contenu dans le nom ... et de plus
3. Pour être plus précis, lire et trier les propriétés de tes fichiers comme DateCreated ou DateLastModified ...
Bon Courage pour la suite ...
Merci James ...
Malheureusement je ne peux pas changer les noms des fichiers créés ( qui ne contiennent pas de dates) car dump automatique et tout le tralala.
Mais je vais réfléchir à ton point 3 !
Merci encore !
Bonne journée,
Edit : J'avaisi mal lu :p tu parles pas de modifier les noms ! Je vais donc réfléchir au point 1, 2 et 3
Merci
Hello,
Non je beug je ne parviens pas à trouver l'avant dernier fichier présent dans le folder... Si quelqu'un veut offrir un coup de main je suis preneur
Merci
Re,
Dans la mesure où il s'agit de rédiger du code ... je propose que tu postes ta dernière tentative ... même infructueuse ...
Salut James ...
J'y penserais une prochaine fois ... En attendant mon échéance pour faire ce que je devais faire est passée
Merci quand même pour le coup de main !
Bonne journée
Bonjour,
un essai :
Sub test()
'Declare the variables
Dim MyPath As String
Dim MyFile As String
Dim idx As Long, listFich() As Variant, fini As Boolean
ReDim listFich(1 To 2, 1 To 1), tmp(2)
'ton répertoir, à modifier en fonction de ce que tu veux
MyPath = "d:\tmp\"
'Make sure that the path ends in a backslash
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
'Get the first Excel file from the folder
MyFile = Dir(MyPath & "*.xls", vbNormal)
'If no files were found, exit the sub
If Len(MyFile) = 0 Then
MsgBox "No files were found...", vbExclamation
Exit Sub
End If
'Loop through each Excel file in the folder
Do While Len(MyFile) > 0
'Assign the date/time of the current file to a variable
idx = idx + 1
ReDim Preserve listFich(1 To 2, 1 To idx)
listFich(1, idx) = FileDateTime(MyPath & MyFile)
listFich(2, idx) = MyFile
'Get the next Excel file from the folder
MyFile = Dir
Loop
' trier tableau dates décroissantes
Stop
Do
fini = True
For idx = 1 To UBound(listFich, 2) - 1
If listFich(1, idx) < listFich(1, idx + 1) Then
tmp(1) = listFich(1, idx)
tmp(2) = listFich(2, idx)
listFich(1, idx) = listFich(1, idx + 1)
listFich(2, idx) = listFich(2, idx + 1)
listFich(1, idx + 1) = tmp(1)
listFich(2, idx + 1) = tmp(2)
fini = False
End If
Next idx
Loop Until fini
'dernier fichier
MsgBox listFich(2, 1)
' avant dernier
MsgBox listFich(2, 2)
' etc
'Workbooks.Open MyPath & LatestFile
End Suberic
Bonjour Eriic,
Un mot : c'est juste parfait
Mais maintenant au moins la prochaine fois je le saurai !
Un grand merci de t'être pencher sur la question ( et à James aussi)
Bon weekend !
Ah, je n'avais pas vu la 2nde page, d'où ma réponse sans avoir vu que c'était trop tard.
Tant pis
eric
Il n'est jamais trop tard
Merci.