Potřebujete najít a otevřít nejnovější soubor ve složce? Následující makro tento soubor najde a také vypíše jeho jméno. Můžete tak poté navázat dalším makrem a soubor zpracovat, jak potřebujete.
Hlavní část kódu, která řadí soubory dle data (a času) a najde ten nejnovější, je níže. Smyčka prochází všechny soubory ve složce a do proměnné MostRecentFile postupně zapisuje nejnovější soubor na základě jeho časového razítka.
If FileName <> "" Then
MostRecentFile = FileName
MostRecentDate = FileDateTime(Directory & FileName)
Do While FileName <> ""
If FileDateTime(Directory & FileName) > MostRecentDate Then
MostRecentFile = FileName
MostRecentDate = FileDateTime(Directory & FileName)
End If
FileName = Dir
Loop
End If
Začněme však od úplného začátku. Jako úplně první krok přidejte nový modul, do kterého budete postupně vkládat samotný kód.
Klikněte pravým na ThisWorkbook, Insert, Module.
Nyní můžeme přejít k vkládání samotného kódu a postupně jej psát.
Nejdříve pro úplnost definujme proměnné, které budou použity v hlavní části kódu. Nicméně i bez nich by hlavní část fungovala.
Dim FileName As String
Dim MostRecentFile As String
Dim MostRecentDate As Date
Dim FileSpec As String
Jako další pokračujme specifikací, jaký typ souboru hledáme. V případě níže je to běžný Excel soubor s příponou xlsx. Pokud budeme chtít vyhledat jiný typ, změníme část za tečkou na typ, který hledáme. Případně, pokud složka obsahuje pouze jeden typ souborů, lze tuto část přeskočit.
FileSpec = "*.xlsx"
Dále je potřeba definovat, v jaké složce se soubory nachází. Příkaz ThisWorkbook.Path ukazuje cestu do šložky, ve které se soubor, ze kterého makro spouštíte, nachází. Soubor tak můžete sdílet napříč složkami nebo i počítači, jelikož se zde používá relativní cesta samotného souboru.
Directory = ThisWorkbook.Path & "\source\"
V případě, že relativní cesta samotného souboru není přesně to, co potřebujete, stačí zkopírovat a vložit úplnou cestu souboru. Např.:
Directory = "C:\report\source\"
Nyní již spojíme cestu k souboru a jeho typ do proměnné FileName.
FileName = Dir(Directory & FileSpec)
Poté již na řadu přichází samotné vyhledání nejnovějšího souboru. Pokud se ve složce nachází nějaký soubor, dojde k jeho vyhledání.
If FileName <> "" Then
MostRecentFile = FileName
MostRecentDate = FileDateTime(Directory & FileName)
Do While FileName <> ""
If FileDateTime(Directory & FileName) > MostRecentDate Then
MostRecentFile = FileName
MostRecentDate = FileDateTime(Directory & FileName)
End If
FileName = Dir
Loop
End If
Soubor jsme již vyhledali, zobrazme si jeho jméno pro kontrolu a toto jméno zapišme pro účely dalšího zpracování. Stejně tak se může hodit nechat si zobrazit oznámení pro případ, že složka žádné soubory neobsahovala.
If MostRecentFile <> "" Then
MsgBox (MostRecentFile)
Else: MsgBox ("No file found")
End If
ThisWorkbook.Sheets("setup").Range("C2") = MostRecentFile
Jméno souboru bylo zapsáno do buňky C2 na listu setup. Toto samozřejmě můžete změnit dle vlastní potřeby.
Pro úplnost je přiložen celý kód, který lze zkopírovat do vašeho modulu a celé makro začít využívat.
Sub lastFile()
Dim FileName As String
Dim MostRecentFile As String
Dim MostRecentDate As Date
Dim FileSpec As String
'Specify the file type, optional
FileSpec = "*.xlsx"
'Specify the directory
Directory = ThisWorkbook.Path & "\source\"
'File name consists of the name and its extension
FileName = Dir(Directory & FileSpec)
'Go through all file names and look for the most recent
If FileName <> "" Then
MostRecentFile = FileName
MostRecentDate = FileDateTime(Directory & FileName)
Do While FileName <> ""
If FileDateTime(Directory & FileName) > MostRecentDate Then
MostRecentFile = FileName
MostRecentDate = FileDateTime(Directory & FileName)
End If
FileName = Dir
Loop
End If
'Display the most recent file name. If there was no file in the folder, state that in the message box
If MostRecentFile <> "" Then
MsgBox (MostRecentFile)
Else: MsgBox ("No file found")
End If
'Write the file name to the cell C2 on the tab setup
ThisWorkbook.Sheets("setup").Range("C2") = MostRecentFile
End Sub
Soubor s funkčním makrem můžete stáhnout z linku níže