În acest articol, vom crea o macro pentru a aduna detalii despre toate fișierele dintr-un folder.
Înainte de a rula macro-ul, trebuie să specificăm calea folderului în caseta de text.
La executarea macro-ului, acesta va returna numele fișierului, calea fișierului, dimensiunea fișierului, data creării și data ultimei modificări a tuturor fișierelor din dosar.
Explicație logică
În acest articol, am creat două macrocomenzi „ListFilesInFolder” și „TestListFilesInFolder”.
Macro-ul „ListFilesInFolder” va afișa detalii legate de toate fișierele din folder.
„TestListFilesInFolder” este utilizată pentru a specifica antetul și a apela macrocomanda „ListFilesInFolder”.
Explicarea codului
Setați FSO = CreateObject ("Scripting.FileSystemObject")
Codul de mai sus este utilizat pentru a crea un nou obiect al sistemului de fișiere.
Set SourceFolder = FSO.GetFolder (SourceFolderName)
Codul de mai sus este utilizat pentru a crea un obiect al folderului specificat de cale.
Celule (r, 1) .Formula = FileItem.Name
Celule (r, 2) .Formula = FileItem.Path
Celule (r, 3) .Formula = FileItem.Size
Celule (r, 4) .Formula = FileItem.DateCreated
Celule (r, 5) .Formula = FileItem.DateLastModified
Codul de mai sus este utilizat pentru a extrage detalii despre fișiere.
Pentru fiecare subfolder din SourceFolder.SubFolders
'Apelarea aceleiași proceduri pentru subdosare
ListFilesInFolder SubFolder.Path, True
Următorul subfolder
Codul de mai sus este folosit pentru a extrage detalii despre toate fișierele din sub-foldere.
Coloane („A: E”). Selectați
Selection.ClearContents
Codul de mai sus este utilizat pentru a șterge conținutul din coloana A la E.
Vă rugăm să urmați codul de mai jos
Opțiune Explicit Sub ListFilesInFolder (ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean) 'Declaring variables Dim FSO As Object Dim SourceFolder As Object Dim SubFolder As Object Dim FileItem As Object Dim r As Long' Crearea obiectului FileSystemObject Set FSO = CreateObject ("Script .FileSystemObject ") Set SourceFolder = FSO.GetFolder (SourceFolderName) r = Range (" A65536 "). End (xlUp) .Row + 1 For Each FileItem In SourceFolder.Files 'Display file properties Cells (r, 1) .Formula = FileItem.Name Cells (r, 2) .Formula = FileItem.Path Cells (r, 3) .Formula = FileItem.Size Cells (r, 4) .Formula = FileItem.DateCreated Cells (r, 5) .Formula = FileItem. DateLastModified r = r + 1 Următorul FileItem 'Obținerea fișierelor în subdosare dacă IncludeSubfoldere apoi pentru fiecare subfolder din SourceFolder.SubFolders' Apelând aceeași procedură pentru subfoldere ListFilesInFolder SubFolder.Path, True Next SubFolder End if Set FileItem = Nothing Set SourceFolder = Nothing Set FSO = Nimic ActiveWorkbook.Saved = Adevărat End Sub Sub TestListFilesInFolder () 'Declararea variabilei Dim FolderPath as String' Dezactivarea actualizărilor ecranului Application.ScreenUpdating = False 'Obținerea căii folderului din caseta de text FolderPath = Sheet1.TextBox1.Value ActiveSheet.Activate' Ștergerea conținutului din coloanele A: E Coloane ("A: E"). Selectați Selection.ClearContents 'Adăugarea antetelor Range ("A14"). Formula = "Nume fișier:" Range ("B14"). Formula = "Path:" Range ("C14"). Formula = "Dimensiune fișier:" Interval ("D14"). Formula = "Data creării:" Interval ("E14"). Formula = "Data ultimei modificări:" 'Formarea antetelor Interval ("A14: E14"). Font .Bold = True 'Apelare ListFilesInFolder macro ListFilesInFolder FolderPath, True' Reglarea automată a dimensiunii coloanelor Coloane ("A: E"). Selectați Selection.Columns.AutoFit Range ("A1"). Selectați End Sub
Dacă ți-a plăcut acest blog, distribuie-l prietenilor tăi de pe Facebook. De asemenea, ne puteți urmări pe Twitter și Facebook.
Ne-ar plăcea să aflăm de la dvs., să ne anunțați cum putem îmbunătăți munca noastră și o putem îmbunătăți. Scrieți-ne pe site-ul de e-mail
