Gyakran megesik, hogy egy adott mappában keresünk fájlokat bizonyos kritériumok alapján. Ezek közül az egyik leggyakoribb a módosítás dátuma/ideje.
Tegyük fel, hogy van egy összesítő munkafüzetünk (amint azt ebben a bejegyzésben láthattátok), és a legutoljára módosított input fájl adataival akarjuk azt frissíteni.
Ehhez nyújt segítséget a lenti kód, mely kilistázza a kiválasztott mappa munkafüzeteit, mégpedig módosítás dátuma/ideje szerinti csökkenő sorrendben. Mindezt a gyakorlatban az alábbi animációval prezentálom:
Az adott munkafüzetbe szúrjunk be egy modult a Visual Basic szerkesztőjében és a kapcsolódó makrót adjuk hozzá:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 |
Sub FajlnevekRendezese() Dim FajlHelye As String, FajlNeve As String Dim D As Object, D2 As Object, X, Y, i As Long, j As Long, Csere As Date, Csere2 As String, Szoveg As String 'Készítette: XLMotyo (https://xlmotyo.hu) 'a felhasználó által kiválasztott mappa Excel fájljainak neveit és módosítási dátumát/idejét kilistázza, 'a létrehozás vagy a legutóbbi módosítás dátuma/ideje szerinti csökkenõ sorrendben 'ha két vagy több fájlnál - másodpercre pontosan - megegyezik a módosítás dátuma és ideje, 'akkor csak az elsõ ilyen fájlt listázza ki 'nincs limit hogy hány fájlt tartalmazó mappát választhatunk ki Application.ScreenUpdating = False Set D = CreateObject("scripting.dictionary") Set D2 = CreateObject("scripting.dictionary") 'felhasználó jelölje ki a mappát: Application.FileDialog(msoFileDialogFolderPicker).Show On Error GoTo Vege FajlHelye = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & Application.PathSeparator FajlNeve = Dir(FajlHelye & "*xl??") On Error GoTo 0 'Fájlok módosítási dátumának/idejének és nevének eltárolása Dictionary objektumban: Do While FajlNeve <> "" D(FileDateTime(FajlHelye & FajlNeve)) = "" D2(FajlNeve) = "" FajlNeve = Dir() Loop X = D.keys Y = D2.keys 'Buborék rendezés (Bubble sort): dátum/idõ szerinti rendezés csökkenõ sorrendben: For i = 0 To D.Count - 1 For j = 0 To D.Count - 2 If X(j) < X(j + 1) Then 'dátumok/idõk rendezése: Csere = X(j) X(j) = X(j + 1) X(j + 1) = Csere 'fájlnevek rendezése: Csere2 = Y(j) Y(j) = Y(j + 1) Y(j + 1) = Csere2 End If Next j Next i 'Dátumok/idõk és nevek betöltése a "Szoveg" típusú szöveges változóba: For i = 0 To D.Count - 1 If i = 0 Then Szoveg = "Fájl neve" & vbTab & vbTab & "Módosítás dátuma/ideje" & vbNewLine Szoveg = Szoveg & Y(i) & vbTab & X(i) & vbNewLine Next i 'Microsoft súgó: MsgBox-nál a megjeleníthetõ karakterek maximális száma hozzávetõlegesen 1024, 'a használt karakterek szélességétõl függõen. Vagyis ha a szövegünk ennél hosszabb, akkor az nem lesz megjelenítve. 'Megoldás: ûrlap (userform), azon belül mondjuk címke (label) használata, esetleg használjunk kettõ vagy több msgbox-ot. If D.Count <> 0 Then MsgBox Szoveg, , "Módosítás dátuma/ideje szerint csökkenõ sorrend" Else MsgBox "Nem található sorba rendezhetõ Excel fájl!", vbExclamation, "" Exit Sub End If Application.ScreenUpdating = True Vege: End Sub |
A fenti VBA kód egyik leglényegesebb eleme a FileDateTime funkció. Egy Dátum (Date) típusú változó. A fájl létrehozásának illetve utolsó módosításának dátumát és idejét adja vissza. A dátum és idő megjelenítésének formátuma függ a rendszer helyi beállításától.
További leírás angolul itt.
A makró kimenetét összevethetjük a Windows Fájlkezelőben lévő listával:
Látható, hogy a fájlnevek illetve a módosítási dátum és idő is megegyezik azzal a különbséggel, hogy a makrós kimenet a másodpercet is mutatja.
