Ouvrir le fichier dont le nom comporte la date la plus récente

WIsh_

XLDnaute Occasionnel
Bonjour à tous,

Ci-après un extrait de code d'une de mes macros qui ouvre un classeur qui se trouve dans un dossier pour en copier une plage de donnée:

VB:
Set wbData = Workbooks.Open("D:\test rapport\Project_Rapport 2020_Situation -17052020_LONG.xlsm")
Set wsData = wbData.Worksheets("BA RE T.C.")

Union(wsData.Range("BARETC1"), wsData.Range("BARETC2")).Copy

With WsMaster1.Cells(Ligne, 14)
.PasteSpecial xlPasteValues
End With

Application.CutCopyMode = False

A l'emplacement "D:\test rapport\", un nouveau fichier vient s'ajouter chaque semaine. Et c'est ce fichier que je dois aller ouvrir pour en copier les données.
Le nom du fichier est toujours identique, sauf la date qu'il comporte : "Project_Rapport 2020_Situation -17052020_LONG.xlsm".

Ainsi, la semaine prochaine, le fichier à aller chercher s'appellera "Project_Rapport 2020_Situation -18052020_LONG.xlsm", et celui de la semaine d'après, "Project_Rapport 2020_Situation -27052020_LONG.xlsm", etc.

=> Je n'arrive pas à remplacer ma ligne de code pour que la macro ouvre à chaque fois le fichier du dossier qui comporte dans son nom la date la plus récente.

Quelqu'un aurait-il une idée ?

Merci beaucoup d'avance,
Wish
 
Dernière édition:
Solution
re
VB:
Option Explicit
Sub test()
    Dim wbData As Workbook
    Dim pth As String       'path
    Dim prf As String       'préfixe
    Dim suf As String       'suffixe
    Dim nom As String       'nom
    Dim dat As Date         'date
    Dim dat2 As Date        'date
    Dim fichier$

    dat = CDate("01/01/1900")
    pth = "C:\Users\polux\DeskTop\33740\"
    prf = "Project_Rapport 2020_Situation -"
    suf = "_LONG.xlsm"
    nom = Dir(pth & prf & "*" & suf)
    Do While nom > ""
        nom = Trim(Replace(Replace(nom, prf, ""), suf, ""))
        If IsNumeric(nom) And Len(nom) = 8 Then
            If IsDate(Format(nom, "##/##/####")) Then
                dat2 = CDate(Format(nom, "##/##/####"))
                If dat2 > dat Then fichier...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Wlsh,
Ne pourriez vous pas vous rattacher à la date d'enregistrement du dit fichier ?
Sinon il va vous falloir lire tous les noms de fichiers, en extraire les dates puis regarder le plus récent pour l'ouvrir. Parce que tel qu'elle est, la date est une chaîne de caractères au sein d'une autre chaîne.
 

Patrice33740

XLDnaute Impliqué
Bonjour,

Par exemple :
VB:
Option Explicit
Sub Test()
Dim wbData As Workbook
Dim pth As String       'path
Dim prf As String       'préfixe
Dim suf As String       'suffixe
Dim nom As String       'nom
Dim dat As String       'date

  pth = "D:\test rapport\"
  prf = "Project_Rapport 2020_Situation -"
  suf = "_LONG.xlsm"
  nom = Dir(pth & prf & "*" & suf)
  Do While nom > ""
    nom = Right("0" & Replace(Replace(nom, prf, ""), suf, ""), 8)
    If Mid(nom, 5, 4) & Mid(nom, 3, 2) & Mid(nom, 1, 2) > dat Then dat = Mid(nom, 5, 4) & Mid(nom, 3, 2) & Mid(nom, 1, 2)
    nom = Dir
  Loop
  Set wbData = Workbooks.Open(pth & prf & Mid(dat, 7, 2) & Mid(dat, 5, 2) & Mid(dat, 1, 4) & suf)
  '...

End Sub
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
bonjour à tous
puré" ké galère!!" cette conception

bon je ne peux pas tester n'ayant pas ton arborescence de fichier mais je tente

VB:
Sub test()
    chemin = "D:\test rapport\"    'chemin de base
    MsgBox GetRecentFiche(chemin)
End Sub
''
Function GetRecentFiche(chemin)
    dat = CDate("01/01/1900")    ' ancienne date pour etre sur
    partname = "Project_Rapport 2020_Situation -"    'partie invariable du nom de fichier
    fichiers = Dir(chemin, partname & "*_LONG.xlsm")    'lancement de dir pour lister les fichiersavec partname + inconu+suffixe et extention
    Do While fichiers <> ""    'demarrage de boucle dir
        inconu = Trim(Split(Split(fichiers, partname)(1), "_")(0))    'récup' serie numerique supposée existante
        If IsNumeric(inconu) And Len(inconu) = 8 Then    'teste si numerique et 8 caracteres
            inconu = Format(inconu, "##/##/####")    'conversion en date de l'inconu
            If IsDate(inconu) Then    'si inconu est date valide
                If CDate(inconu) > dat Then dat = inconu    'si date inconu > dat alors dat=inconu date
            End If
        End If
    End If

    fichiers = fir
Loop
x = chemin & partname & dat & "_LONG.xlsm" 'reconstruction du chemin complet avec le "dat" résultant
If Dir(x) <> "" Then GetRecentFiche = x 'si dir dit pas "" alors c'est choppé
End Function
 

patricktoulon

XLDnaute Barbatruc
re
oui ben re teste alors!! et pas avec des nom qui t'arrangent
exemple avec

'Project_Rapport 2020_Situation -05062020_LONG.xlsm
'Project_Rapport 2020_Situation -03092021_LONG.xlsm

et dis moi que ton truc marche encore
dis moi qu'avec "Mid(nom, 1, 2) > dat Then dat = Mid(nom, 5, 4)" ca va te sortir le 2d

;)
 

jmfmarques

XLDnaute Accro
Bonjour Patrice33740

regarde et comprends ce que fait ceci :
VB:
ch = "Project_Rapport 2020_Situation -27052020_LONG.xlsm"
ch = Format(Val(Mid(ch, InStrRev(ch, "-") + 1)), "00000000")
dch = DateSerial(Right(ch, 4), Mid(ch, 3, 2), Left(ch, 2))
MsgBox dch
dch étant maintenant une date, tu peux la comparer telle quelle avec les autres valeurs dch

je te laisse faire.
amitiés
 
Dernière édition:

Patrice33740

XLDnaute Impliqué
Bonjour Patrice33740
regarde et comprends ce que fait ceci :
VB:
ch = "Project_Rapport 2020_Situation -27052020_LONG.xlsm"
ch = Val(Mid(ch, InStrRev(ch, "-") + 1))
dch = DateSerial(Right(ch, 4), Mid(ch, 3, 2), Left(ch, 2))
MsgBox dch
dch étant maintenant une date, tu peux la comparer telle quelle avec les autres valeurs dch
Il n'est nullement obligatoire de convertir la chaine en date pour la comparer avec les autres !
La macro que j'ai proposé fonctionne parfaitement !
Je me contente de la transformer en 20200517 ou 20200527 pour les comparer :: la seconde est supérieure à la première.
Ceci dit, j'ai toujours trouvé aberrant d'écrire la date au format jjmmaaaa dans le nom d'un fichier, j'emploie toujours aaaammjj (ou une variante).
 

Discussions similaires