Macro dernier fichier hier

wendtyfuht -  
 wendtyfuht -

Bonjour,

j'ai une macro qui va me chercher le temps fichier mis à jour dans un dossier. J'aimerai pouvoir aller chercher le dernier fichier mis à jour  mais de la vieille (J-1) et si possible mais pas obligatoire sans prendre en compte le samedi et dimanche. (lundi je prend le fichier de vendredi)

Voici la partie de la macro:

Sub Extraction_KPI_stand_up_J_1()


'Extraction macro

    Dim Dossier As String
    Dim Fichier As String
    Dim Last_date As Date
    
    Dim Dernier_Fichier As String


    Dossier = ThisWorkbook.Worksheets("Lien").Range("B2").Value
    Fichier = Dir(Dossier & "*.xlsx")
    Last_date = DateSerial(1, 1, 1)
  
    Do While Fichier <> ""
    If FileDateTime(Dossier & Fichier) > Last_date Then

    
    Dernier_Fichier = Dossier & Fichier
    Last_date = FileDateTime(Dossier & Fichier)
    
    End If
    Fichier = Dir
    Loop
  
    ThisWorkbook.Worksheets("Lien").Range("B3") = Dernier_Fichier
    ThisWorkbook.Worksheets("Tableau_de_Bord").Range("N17") = Last_date

Windows / Chrome 103.0.0.0

A voir également:

2 réponses

Réponse 1 / 2
ozone_ Messages postés 1823 Statut Membre 478
 

Bonjour,

Un test à faire avec ce bout de macro :

Sub Extraction_KPI_stand_up_J_1()


'Extraction macro

    Dim Dossier As String
    Dim Fichier As String
    Dim Last_date As Date
    Dim Dernier_Fichier As String


    Dossier = ThisWorkbook.Worksheets("Lien").Range("B2").Value
    Fichier = Dir(Dossier & "*.xlsx")
    
    If Weekday(Date) = 1 Then
        Last_date = Date - 3
    Else
        Last_date = Date - 1
    End If

    Do While Fichier <> ""
        
        If Format(FileDateTime(Dossier & Fichier), "dd/mm/yyyy") = Last_date Then
            Dernier_Fichier = Dossier & Fichier
            Last_date = FileDateTime(Dossier & Fichier)
            Exit Do
        End If
        
    Fichier = Dir
    Loop
     
    If Dernier_Fichier <> "" Then
        ThisWorkbook.Worksheets("Lien").Range("B3") = Dernier_Fichier
        ThisWorkbook.Worksheets("Tableau_de_Bord").Range("N17") = Last_date
    Else
        ThisWorkbook.Worksheets("Lien").Range("B3") = "Pas de fichier de la veille présent dans le répertoire"
        ThisWorkbook.Worksheets("Tableau_de_Bord").Range("N17") = Last_date
    End If
    
End Sub

1
yg_be Messages postés 24281 Statut Contributeur 1 584
 

bonjour,

Je combinerais le code de départ  et la suggestion de ozone_, ainsi:

Sub Extraction_KPI_stand_up_J_1()


'Extraction macro

    Dim Dossier As String
    Dim Fichier As String
    Dim Last_date As Date, jour as date, df as date
    
    Dim Dernier_Fichier As String


    Dossier = ThisWorkbook.Worksheets("Lien").Range("B2").Value
    Fichier = Dir(Dossier & "*.xlsx")
    Last_date = DateSerial(1, 1, 1)
    If Weekday(Date) = 1 Then
        jour = Date - 3
    Else
        jour = Date - 1
    End If
  
    Do While Fichier <> ""
    df = FileDateTime(Dossier & Fichier)
    If int(df) = jour and df > Last_date Then

    
    Dernier_Fichier = Dossier & Fichier
    Last_date = df
    
    End If
    Fichier = Dir
    Loop
  
    ThisWorkbook.Worksheets("Lien").Range("B3") = Dernier_Fichier
    ThisWorkbook.Worksheets("Tableau_de_Bord").Range("N17") = Last_date
1
wendtyfuht
 

Bonjour, merci beaucoup pour l'aide j'essaye ça demain en retournant au boulot :)

0
Réponse 2 / 2
wendtyfuht
 

qui va me chercher le dernier fichier maj*
0