VBA Ouverture d'un fichier Excel avec la date d'hier

Bonjour,

Dans un dossier DossierX je veux ouvrir un fichier Excel de la date d'hier si existant et qui est sous la forme : Texte1_yyyy_mm_dd hh_mm_ss_Texte2.xlsx

Sachant que la partie hh_mm_ss change presque pour chaque fichier existant dans le dossier DossierX.

Sub Ouverture_Fichier

Chemin = "C:\DossierX\"

DateJourPrecedent = Date - 1

Dim Heure As String

Heure = Format("hh_mm_ss")

NomFichier = "Texte1_" & Format(DateJourPrecedent, "yyyy_mm_dd") & " " & Heure & "_Texte2.xlsx"

    If Dir(Chemin & NomFichier) <> "" Then

        Workbooks.Open Chemin & NomFicher

    Else

        MsgBox "Le fichier de la date d'hier : " & NomFichier & " introuvable dans le DossierX!?"

    End If

End Sub

Je sais que c'est possible de remplacer les chiffres dans un caractère par des # mais je n'ai pas la syntaxe exacte du genre :

NomFichier = "StatistiqueAuthDgsn_" & Format(DateJourPrecedent, "yyyy_mm_dd") & " " & ## & "_" & ## & "_" & ## & "_Complété_Résultat.xlsx" 

Les ## & "_" & ## & "_" & ## pour remplacer les nombres aléatoires de hh_mm_ss

Merci par avance pour votre réponse.

Bonjour,

Si la date et l'heure sont formatés dans une seule cellule, essayez cette fonction :

Function GroupeDateHeure2(ByVal LeJour As Date) As String

Dim DateDeCreation As String
Dim HeureEnCours As Variant

    DateDeCreation = Year(LeJour) & "_" & Format(Month(LeJour), "00") & "_" & Format(Day(LeJour), "00")
    HeureEnCours = Split(Format(LeJour - Int(LeJour), "[$-x-systime]hh:mm:ss"), ":")
    GroupeDateHeure2 = DateDeCreation & " " & Join(HeureEnCours, "_")

End Function

Si la date et l'heure sont dans deux cellules distinctes :

Function GroupeDateHeure3(ByVal LeJour As Date, ByVal LHeure As Variant) As String

Dim DateDeCreation As String
Dim HeureEnCours As Variant

    DateDeCreation = Year(LeJour) & "_" & Format(Month(LeJour), "00") & "_" & Format(Day(LeJour), "00")
    HeureEnCours = Split(Format(LHeure, "[$-x-systime]hh:mm:ss"), ":")
    GroupeDateHeure3 = DateDeCreation & " " & Join(HeureEnCours, "_")

End Function

Bonjour,

Merci pour votre réponse M. Eric.

Pour le nom du fichier .xlsx qui est : Texte1_yyyy_mm_dd hh_mm_ss_Texte2.xlsx

Pour la date et l'heure ne sont pas dans une seule cellule ou deux cellules distinctes, mais plutôt c'est un fichier que je reçois par email est généré suite à une extraction faite par le système ou une application.

Merci par avance pour votre retour.

Est-ce que la chaine Texte1_yyyy_mm_dd est suffisante pour retrouver le fichier ?

Oui c'est possible avec cette chaine Texte1_yyyy_mm_dd.xlsx et même avec Texte1_yyyy_mm_dd Texte2.xlsx je sais le faire.

Mon but de garder tout le nom du fichier Texte1_yyyy_mm_dd hh_mm_ss_Texte2.xlsx reçu par email si possible.

Merci par avance pour votre retour.

A tester

Sub OuvertureFichier()

Dim ChaineATrouver As String
Dim NomDuFichier As String

    ChaineATrouver = "Texte1_" & Year(Date - 1) & "_" & Format(Month(Date - 1), "00") & "_" & Format(Day(Date - 1), "00")
    NomDuFichier = FichierJourMoins1("C:\DossierX\", ChaineATrouver)
    If NomDuFichier <> "" Then
       Workbooks.Open NomDuFichier
    End If

End Sub

Function FichierJourMoins1(ByVal Chemin As String, ByVal ChaineDansNomFichier As String) As String

Dim Fso As Object, Dossier_Racine As Object, Fichier As Object, Fichiers As Object

    FichierJourMoins1 = ""
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Dossier_Racine = Fso.getfolder(Chemin)
    Set Fichiers = Dossier_Racine.Files

    For Each Fichier In Fichiers
        Select Case Fso.GetExtensionName(Fichier)
               Case Is = "xlsx"
                    If InStr(1, Fichier.Name, ChaineDansNomFichier, vbTextCompare) > 0 Then
                       FichierJourMoins1 = Fichier.Name
                       Exit For
                    End If
        End Select
    Next Fichier

    Set Fichiers = Nothing: Set Dossier_Racine = Nothing: Set Fso = Nothing

End Function

Merci pour votre retour

Je reçois le message ci-dessous

A noter que j'ai ajouté le Chemin dans la Function FichierJourMoins1

Chemin = "C:\DossierX\"

Merci par avance pour votre retour.

A quel endroit cela beugue ? Repérer dans l'éditeur VBA la ligne en jaune.

En exécutant F8.

Le dossier contient 5 fichiers Excel, et la Fonction s'exécute 4 fois puis une fois sur la Sub pour ouvrir le fichier une fois sur Workbooks.Open NomDuFichier surligné en jaune je reçois le message d'erreur.

Merci par avance pour votre retour.

Modifiez le code de la fonction :

Function FichierJourMoins1(ByVal Chemin As String, ByVal ChaineDansNomFichier As String) As String

Dim Fso As Object, Dossier_Racine As Object, Fichier As Object, Fichiers As Object

    FichierJourMoins1 = ""
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Dossier_Racine = Fso.getfolder(Chemin)
    Set Fichiers = Dossier_Racine.Files

    For Each Fichier In Fichiers
        Select Case Fso.GetExtensionName(Fichier)
               Case Is = "xlsx"
                    If InStr(1, Fichier.Name, ChaineDansNomFichier, vbTextCompare) > 0 Then
                       FichierJourMoins1 = Chemin & Fichier.Name
                       Exit For
                    End If
        End Select
    Next Fichier

    Set Fichiers = Nothing: Set Dossier_Racine = Nothing: Set Fso = Nothing

End Function

Opération réussie

Mille merci M. ERIC pour vos réponses et vos efforts

ReBonjour M. ERIC

SVP comment intégrer ceci dans Workbooks ou dans RechercheV?

J'ai essayé les deux codes mais un message d'erreur qui bloque.

WORKBOOKS

Workbooks("Texte1_" & Year(Date - 1) & "_" & Format(Month(Date - 1), "00") & "_" & Format(Day(Date - 1), "00"))").Sheets("Test").Activate

OU

Workbooks("Texte1_" & Year(Date - 1) & "_" & Format(Month(Date - 1), "00") & "_" & Format(Day(Date - 1), "00")) & "*.xlsx").Sheets("Test").Activate

RECHERCHEV

ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC[-5]&RC[-4], '[ChaineATrouver]Test'!R3C4:R500C11, 5, 0)"

OU

ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC[-5]&RC[-4], '[ChaineATrouver & *.xlsx]Test'!R3C4:R500C11, 5, 0)"

Merci par avance pour votre retour.