Ouverture automatique fichier le plus récent

DJARNAUD

XLDnaute Occasionnel
Bonjour tout le monde!

Je souhaiterai créer une macro qui me permettrait d'ouvrir le dernier fichier excel téléchargé et présent dans un dossier. J'ai bien trouvé des solutions sur le forum, mais rien ne répondant à ma demande.
De plus, dans le titre des dossiers, il n'y a qu'une partie qui est fixe: AP ensuite se trouve des lettres et des chiffres aléatoires.

merci d'avance!

Arnaud
 

Staple1600

XLDnaute Barbatruc
Re : Ouverture automatique fichier le plus récent

Bonjour à tous


En direct de mes archives, un code de Jerry Sullivan
Si tu as besoin d'explication sur le code, n'hésites pas ;)

PS: On doit pouvoir faire plus court en empruntant d'autres voies comme les Builtin Properties, mais je laisse le sécateur à mes petits camarades de jeu ;)

Code:
Sub TestGetLastFile()
   Const sPattern As String = "C:\Test\*.xls*"
   Dim sReturn As String
   
   sReturn = GetLastFile(sPattern)
   
   If sReturn = vbNullString Then
      MsgBox "No files found matching pattern: """ & _
         sPattern & """"
   Else
      MsgBox "The newest file matching pattern: """ & _
         sPattern & """ was found at: " & vbCr _
         & sReturn
   End If
End Sub

Function GetLastFile(sPattern As String) As String
'--returns path of the file meeting the pattern
'     with the newest modified date
Dim vMatches As Variant
Dim i As Long
Dim dModified As Double, dLastModified As Double
Dim sCommand As String

sCommand = "cmd /u/c dir " & """" & sPattern & """" _
   & " /B /O:D /S /T:W"

vMatches = Split(fShellRunUnicode(sCommand), vbCrLf)

For i = LBound(vMatches) To UBound(vMatches)
   If vMatches(i) <> "" Then
      dModified = FileDateTime(vMatches(i))
      If dModified > dLastModified Then
         dLastModified = dModified
         GetLastFile = vMatches(i)
      End If
   End If
Next i

End Function

Function fShellRunUnicode(sCommandStringToExecute)

' This function will accept a string as a DOS command to execute.
' It will then execute the command in a shell, and capture the output into a file.
' That file is then read in as Unicode and its contents are returned as the value the function returns.

Dim oShellObject, oFileSystemObject, sShellRndTmpFile
Dim oShellOutputFileToRead, iErr

Set oShellObject = CreateObject("Wscript.Shell")
Set oFileSystemObject = CreateObject("Scripting.FileSystemObject")

    sShellRndTmpFile = oShellObject.ExpandEnvironmentStrings("%temp%") & oFileSystemObject.GetTempName
    On Error Resume Next
    oShellObject.Run sCommandStringToExecute & " > " & sShellRndTmpFile, 0, True
    iErr = Err.Number

    On Error GoTo 0
    If iErr <> 0 Then
        fShellRunUnicode = ""
        Exit Function
    End If

    On Error GoTo err_skip
    fShellRunUnicode = oFileSystemObject.OpenTextFile(sShellRndTmpFile, 1, True, -1).ReadAll
    oFileSystemObject.DeleteFile sShellRndTmpFile, True

Exit Function

err_skip:
    fShellRunUnicode = ""
    oFileSystemObject.DeleteFile sShellRndTmpFile, True

End Function
 
Dernière édition:

DJARNAUD

XLDnaute Occasionnel
Re : Ouverture automatique fichier le plus récent

Merci beaucoup Staple1600 pour ta réactivité! J'ai testé ce code, cependant, à chaque fois je n'ai qu'une msgbox qui apparait, mais aucun fichier qui s'ouvre. Je pense qu'il me suffit d'ajout getopenfiles ou quelquechose comme ça mais il reste un probléme: la condition du titre contenant AP n'est pas respecté, comment puis je faire?
D'avance merci!
 

Staple1600

XLDnaute Barbatruc
Re : Ouverture automatique fichier le plus récent

Re


Il faut adapter ceci en conséquence
Const sPattern As String = "C:\Test\*.xls*"

Donc changer le nom du répertoire et le "pattern" du nom fichier
A vue de nez
Const sPattern As String = "C:\NOMDUDOSSIER\A?*.xls*"
ou tout simplement
Const sPattern As String = "C:\NOMDUDOSSIER\A*.xls*"

Ensuite il faudra modifier pour transformer ce qu'afficher le MsgBox en string.
 

DJARNAUD

XLDnaute Occasionnel
Re : Ouverture automatique fichier le plus récent

Oui j'avais modifié le chemin.
Par ocntre je ne savais pas que pattern renvoyé au nom de fichier.
désolé d'être insistant mais la msgbox ne m'intéresse pas, ce que je cherche c'est que le fichier s'ouvre automatiquement. Est ce possible? si oui comment?

merci!
 

Staple1600

XLDnaute Barbatruc
Re : Ouverture automatique fichier le plus récent

Re

Comme je disais précédemment, tout simplement comme ceci ;)
Code:
Sub TestGetLastFile()
   Const sPattern As String = "C:\Temp\T*.xls"
   Dim sReturn As String
   
   sReturn = GetLastFile(sPattern)
   
   If sReturn = vbNullString Then
      MsgBox "No files found matching pattern: """ & _
         sPattern & """"
   Else
    Workbooks.Open sReturn
   End If
End Sub

PS:je viens de tester et cela fonctionne sur mon PC
Là j'ai testé les fichier xls commençant par T
 

DJARNAUD

XLDnaute Occasionnel
Re : Ouverture automatique fichier le plus récent

J'ai enfin réussi!! Merci Staples1600 pour ta patience!
Le fichier s'ouvre bien, cependant le contenu est illisible. c'est un fichier CSV, mais pourtant, que je l'ouvre manuellement, il est exploitable sans probléme. Que puis je faire?

D'avance merci
 

Staple1600

XLDnaute Barbatruc
Re : Ouverture automatique fichier le plus récent

Re


Finalement, j'ai repris le sécateur
Ci-dessous une version qui passe par un autre moyen: FileDateTime
Code:
Sub GetLatestFile()
'source: Conman Mai 2013
Dim strFolder$, strFile$, latestFile$, dtLast    As Date

strFolder = "C:\Temp\"
strFile = Dir(strFolder & "\T*.xls*", vbNormal) ' Excel Files

Do While strFile <> ""
    If FileDateTime(strFolder & strFile) > dtLast Then
        dtLast = FileDateTime(strFolder & strFile)
        latestFile = strFolder & strFile
    End If
    strFile = Dir
Loop
MsgBox latestFile
End Sub

Je te laisse faire le changement pour remplacer le MsgBox par l'ouverture du fichier ;)
 

Staple1600

XLDnaute Barbatruc
Re : Ouverture automatique fichier le plus récent

Suite

Si fichier CSV
Essaies avec: Workbooks.OpenText latestFile, local:=True

(si tu utilises le dernier code posté, en ayant pris soin au préalable de changer sPattern
strFile = Dir(strFolder & "\T*.csv", vbNormal)

Test OK sur mon PC
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 886
Membres
101 830
dernier inscrit
sonia poulaert