VBA Ouvrir un fichier qui change de nom tous les jours

merguez59

XLDnaute Nouveau
Bonjour à tous,

Je souhaite, par une macro, ouvrir un fichier qui change de nom tous les jours (pour ensuite en faire un copié collé)

En fait un requêteur envoie chaque jour dans un répertoire (qui est toujour le même) un fichier excel. Si ce fichier avait le même nom tous les jours (et écrasait le précédent), il n'y aurait pas de problème. Mais chaque jour le fichier s'appelle:

extraction 2014-08-07-08-45-29
demain, ce sera
extraction 2014-08-08-08-45-28
après demain
extraction 2014-08-09-08-45-32

en fait:
c'est l'année, le mois, le jour, l'heure, la minute ET (là où ça se complique), la seconde... qui malheureusement, elle, est assez aléatoire...

Deux possibilités:
• aller chercher le fichier le plus récent du répertoire
• trouver un moyen de chercher le fichier qui se rapproche de "extraction" + date du jour...

Merci d'avance pour votre aide!
 

job75

XLDnaute Barbatruc
Re : VBA Ouvrir un fichier qui change de nom tous les jours

Bonjour merguez59,

1) Créez dans un répertoire (par exemple le bureau) un fichier contenant cette macro :

Code:
Sub RechercheFichier()
Dim chemin$, nomfich$, fich$
chemin = ThisWorkbook.Path & "\Mes fichiers\" 'à adapter
nomfich = Dir(chemin & "*.xls*") '1er fichier du dossier
While nomfich <> ""
  If nomfich > fich Then fich = nomfich 'fichier le plus récent
  nomfich = Dir 'fichier suivant
Wend
If fich <> "" Then Workbooks.Open chemin & fich 'ouverture
End Sub
2) créez un sous-dossier nommé "Mes fichiers" et placez-y tous vos fichiers à étudier.

3) Lancez la macro du fichier du 1).

A+
 

Lone-wolf

XLDnaute Barbatruc
Re : VBA Ouvrir un fichier qui change de nom tous les jours

Bonjour merguez69, job75, Dranreb


Je souhaite, par une macro, ouvrir un fichier qui change de nom tous les jours

Une autre façon de faire.


Liste les fichiers dans un classeur vierge comme ceci:

Code:
Private Sub Workbook_Open()
Range("a2:a20000").ClearContents

Dim Fichiers_Repertoire(10000, 1)
Dim fichier As String
Dim Nb_Fichiers As Long

fichier = Dir$("C:\Mes fichiers\" & "*.*")   ' a modifier
Do While fichier <> ""
    Fichiers_Repertoire(Nb_Fichiers, 0) = fichier
    fichier = Dir$
    Nb_Fichiers = Nb_Fichiers + 1
Loop

Nb_Fichiers = 0

While Fichiers_Repertoire(Nb_Fichiers, 0) <> nom_rep
    Range("a2").Offset(Nb_Fichiers, 0).Value = Fichiers_Repertoire(Nb_Fichiers, 0)
    Nb_Fichiers = Nb_Fichiers + 1
Wend
with Sheets("Feuil1")                           ' a changer aussi
.[A2:P20000].Sort .[A2], xlDescending  'Trie les fichiers par ordre décroissant
.Range("a:a").Columns.AutoFit
end with
End Sub

Dans la feuille listée:

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim fichier As String, cel As Range
If Not Intersect(Target, Range("a2:a20000")) Is Nothing Then
Set cel = Target.Offset(0, 0)
fichier = "C:\Mes fichiers\" & cel.Value   ' a modifier
Workbooks.Open (fichier)
End If
End Sub

Ensuite tu clique sur le classeur que tu veux ouvrir.




A+ :cool:
 
Dernière édition:

merguez59

XLDnaute Nouveau
Re : VBA Ouvrir un fichier qui change de nom tous les jours

Bonjour à vous 3,
Merci.
@Dranreb: je n'ai pas réussi à faire fonctionner ton code...

@job75: ca marche! Mais comment ensuite, (ma macro est plus longue) remplacer dans mon "texte" de macro toutes les fois où l'action appelle ce classeur?
En fait: ouvrir ce fichier n'est que la première étape: ensuite des copier coller et des recherches v sont effectuées depuis ce fichier. Aujourd'hui chaque jour je fait un CTRL H et je remplace le nom du fichier dans la macro (en tout il apparait 5fois).

Merci d'avance!
 

merguez59

XLDnaute Nouveau
Re : VBA Ouvrir un fichier qui change de nom tous les jours

@Dranreb, oui, en effet, j'ai bien remplacé par le répertoire en question. Que voulez vous dire par utiliser NomFic?

Je ne suis pas un utilisateur avancé de VBA. En fait, et pour être le plus complêt possible dans mon explication:

J'ai un classeur excel dans lequel j'ai créé une macro: quand les utilisateurs appuient sur le bouton de la macro: celle-ci ouvre un deuxième classeur qui sert de modèle en terme de formats et de calculs. Un troisème classeur est ensuite ouvert: le fameux extraction 2014-08-07-08-45 + seconde (c'est ce classeur qui change de nom chaque jour), et c'est de ce classeur qu'est effectué à un moment donné: un copié coller valeur vers le deuxième classeur et un recherchev puis tout à la fin une fermture du classeur.

En gros: Si je trouve le moyen d'ouvrir ce classeur qui change de nom chaque jour, je dois aussi pouvoir, dans le reste de la macro: "rappeller" ce classeur qui est maintenant ouvert.

cordialement
 

Patrice33740

XLDnaute Impliqué
Re : VBA Ouvrir un fichier qui change de nom tous les jours

Ce code (à adapter) permet de trouver le fichier ayant la date de création la plus récente :
Code:
' Note : il faut activer les références (dans Outils > Références ...) à :
' - Microsoft Scripting Runtime
' - Microsoft Shell Controls And Automation
'
Public Sub Trouver_Dernier_Fichier()
'Choix et analyse du répertoire
Dim oShell As Shell32.Shell       'Shell
Dim oChoix As Shell32.Folder      'Choix de recherche dossier
Dim sChemin As sing               'Chemin du dossier
Dim sMsg As sing                  'Message de la boite de dialogue

  'Afficher la boite de dialogue
  On Error Resume Next
  sMsg = "Choisir le répertoire à analyser :"
  Set oShell = New Shell32.Shell
  Set oChoix = oShell.BrowseForFolder(0, sMsg, 513)
  sChemin = oChoix.Items.Item.Path
  On Error GoTo 0
  Set oShell = Nothing
  Set oChoix = Nothing

  'Si le chemin est valide
  If sChemin <> "" Then
    '- Afficher le nom du fichier le plus récent
    MsgBox TrouverDernier(sChemin)
  End If
  
End Sub

Private Function TrouverDernier(sChemin As sing) As sing
' Trouve le dernier fichier créé du répertoire.
Dim oFSO As FileSystemObject           'File System Object
Dim oRep As Scripting.Folder           'Dossier à analyser
Dim oFiles As Scripting.Files          'Collection des fichiers du dossier
Dim oFile As Scripting.File            'Fichier
Dim dat As Date                        'Date fichier

'Explorer le dossier
On Error Resume Next
Set oFSO = New FileSystemObject
Set oRep = oFSO.GetFolder(sChemin)         'dossier
Set oFiles = oRep.Files                      'fichiers
'- traiter chaque fichier
For Each oFile In oFiles
  If oFile.DateCreated > dat Then            'ou, selon besoin, oFile.DateLastModified
    TrouverDernier = oFile.Path
    dat = oFile.DateCreated
  End If
Next
On Error GoTo 0
Set oFSO = Nothing
Set oRep = Nothing
Set oFiles = Nothing
Set oFile = Nothing

End Function
 

job75

XLDnaute Barbatruc
Re : VBA Ouvrir un fichier qui change de nom tous les jours

Bonjour le fil, le forum,

@job75: ca marche! Mais comment ensuite, (ma macro est plus longue) remplacer dans mon "texte" de macro toutes les fois où l'action appelle ce classeur?

C'est élémentaire.

A l'ouverture du fichier, créer une variable objet qu'on manipulera ensuite comme on veut :

Code:
Sub RechercheFichier()
Dim chemin$, nomfich$, fich$, DernierClasseur As Workbook
chemin = ThisWorkbook.Path & "\Mes fichiers\" 'à adapter
nomfich = Dir(chemin & "*.xls*") '1er fichier du dossier
While nomfich <> ""
  If nomfich > fich Then fich = nomfich 'fichier le plus récent
  nomfich = Dir 'fichier suivant
Wend
If fich <> "" Then
  Set DernierClasseur = Workbooks.Open(chemin & fich) 'ouverture
  MsgBox DernierClasseur.Name 'pour tester
  '---suite---
End If
End Sub
A+
 

senpan

XLDnaute Junior
Bonjour à tous, le fil, le forum,

J'ai un problème un peu différent.
Je souhaite ouvrir un fichier Excel (bien sur) qui se situe toujours dans le même répertoire mais dont le nom est ainsi fait : ASP - Fichier V7.1.xlsm
Vous l'aurez compris, le numéro de version du fichier est susceptible de changer.

J'ai testé l'astuce de Dranreb sans succes : NomFic = Dir("\\nas\Dossier1\Dossier2\2. Excel " & "ASP - Fichier V" & "*.xlsm").
Cette ligne ouvre le dossier Bibliothèque dans l'explorateur Windows. Moi pas comprendre.

VB:
Sub ASP_BUDGET2()

    Dim NomFic As String
    NomFic = Dir("\\nas\Dossier1\Dossier2\2. Excel " & "ASP - Fichier V" & "*.xlsm")
 
    If Len(Dir(NomFic, vbDirectory)) > 0 Then   'vérifie si le Dossier existe
       Shell Environ("WINDIR") & "\explorer.exe " & NomFic, vbNormalFocus
    End If

End Sub
 
Dernière édition:

Patrice33740

XLDnaute Impliqué
Je souhaite ouvrir un fichier Excel [...] dont le nom est ainsi fait : ASP - Fichier V7.1.xlsm
Vous l'aurez compris, le numéro de version du fichier est susceptible de changer.

J'ai testé l'astuce de Dranreb sans succes : NomFic = Dir("\\nas\Dossier1\Dossier2\2. Excel " & "ASP - Fichier V" & "*.xlsm").
[...] Moi pas comprendre.

Moi pas comprendre également :
Le nom de fichier c'est :
ASP - Fichier V7.1.xlsm
ou
2.Excel ASP - Fichier V7.1.xlsm
?????
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Alors pourquoi cherchez vous un "\\nas\Dossier1\Dossier2\2. Excel ASP - Fichier V*.xlsm"
au lieu de chercher comme il faut "\\nas\Dossier1\Dossier2\2. Excel\ASP - Fichier V*.xlsm" ?

Remarque: Vous pouvez utilisez cette fonction :
VB:
Function Classeur(Optional ByVal ChNomF As String) As Workbook
Rem. — Cherche et renvoie si possible un objet Workbook
'  ChNomF: Identification facultative du classeur.
'     Si elle est vide ou non spécifiée: l'objet retourné représentera un nouveau classeur.
'     Si elle ne comporte pas de "\", cherche un classeur ouvert du seul nom spécifié.
'     Si elle en comporte, cherche un classeur ouvert du nom donné par ce qui suit le
'        dernier "\", et s'il n'y en a pas, tente de l'ouvrir.
'  Remarque: Le caractère générique "*" est accepté dans le nom du fichier.
Dim P As Long, NomFic As String
P = InStrRev(ChNomF, "\"): NomFic = Mid$(ChNomF, P + 1)
If NomFic = "" Then Set Classeur = Workbooks.Add: Exit Function
On Error Resume Next
If InStr(NomFic, "*") > 0 Then
   For Each Classeur In Workbooks
      If Classeur.Name Like NomFic Then Exit Function
      Next Classeur
   Set Classeur = Nothing: If P = 0 Then Exit Function
   NomFic = Dir(ChNomF): If NomFic = "" Then Exit Function
   Set Classeur = Workbooks.Open(Left$(ChNomF, P) & NomFic)
Else
   Set Classeur = Workbooks(NomFic): If Err = 0 Or P = 0 Then Exit Function
   Set Classeur = Workbooks.Open(ChNomF): End If
End Function
Exemple d'utilisation :
VB:
Sub Exemple()
Dim Wbk As Workbook
Set Wbk = Classeur("\\nas\Dossier1\Dossier2\2. Excel\ASP - Fichier V*.*.xlsm")
If Wbk Is Nothing Then
   MsgBox "Aucun fichier trouvé."
Else
   MsgBox "Fichier """ & Wbk.Name & """ ouvert."
   End If
End Sub
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Une version un peu plus élaborée :
VB:
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function CheminMisCourant Lib "kernel32" _
   Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
#Else
Private Declare Function CheminMisCourant Lib "kernel32" _
   Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
#End If
Function Classeur(Optional ByVal ChNomF As String) As Workbook
Rem. — Cherche et renvoie si possible un objet Workbook
'  ChNomF: Identification facultative du classeur.
'     Si elle est vide ou non spécifiée: l'objet retourné représentera un nouveau classeur.
'     Si elle ne comporte pas de "\", cherche un classeur ouvert du seul nom spécifié.
'     Si elle en comporte, cherche un classeur ouvert du nom donné par ce qui suit le
'        dernier "\", et s'il n'y en a pas, tente de l'ouvrir du dossier spécifié devant.
'  Remarques:
'     Adresses de domaines et chemins relatifs au dossier courant sont acceptés.
'     Le caractère générique "*" est accepté dans le nom du fichier.
   Dim P As Long, Dossier As String, NomFic As String, RésuDir As String
   If ChNomF = "" Then Set Classeur = Workbooks.Add: Exit Function
   P = InStrRev(ChNomF, "\"): Dossier = Left$(ChNomF, P - 1): NomFic = Mid$(ChNomF, P + 1)
   If InStr(NomFic, ".") = 0 Then NomFic = NomFic & ".xl*"
   If InStr(NomFic, "*") > 0 Then
      For Each Classeur In Workbooks: If Classeur.Name Like NomFic Then Exit For
         Next Classeur
   Else
      On Error Resume Next: Set Classeur = Workbooks(NomFic): On Error GoTo 0: End If
   If P > 0 Then
      If Dossier <> "" Then If CheminMisCourant(Dossier) = 0 Then _
         MsgBox "Impossible d'ouvrir le dossier suivant :" _
         & vbLf & Dossier, vbCritical, "Classeur": Exit Function
      If Classeur Is Nothing Then
         RésuDir = Dir(NomFic): If RésuDir = "" Then MsgBox "Aucun classeur """ & NomFic _
            & """ trouvé sur :" & vbLf & CurDir, vbCritical, "Classeur": Exit Function
         Set Classeur = Workbooks.Open(RésuDir)
      ElseIf Classeur.Path <> CurDir Then
         MsgBox "Il a bien été trouvé un classeur """ & Classeur.Name & """ ouvert," _
            & vbLf & "mais son chemin est le suivant :" & vbLf & Classeur.Path _
            & vbLf & "et non pas celui ci :" _
            & vbLf & CurDir, vbExclamation, "Classeur"
         End If
   ElseIf Classeur Is Nothing Then
      MsgBox "Aucun classeur """ & NomFic & """ n'est ouvert.", vbCritical, "Classeur"
      End If
   End Function
Sub ExempleDUtilisation()
   Dim Wbk As Workbook
   Set Wbk = Classeur("\\nas\Dossier1\Dossier2\2. Excel\ASP - Fichier V*.*.xlsm")
   If Wbk Is Nothing Then Exit Sub
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG