I den här artikeln kommer vi att skapa ett makro för att samla in detaljer om alla filer i en mapp.
Innan vi kör makrot måste vi ange sökvägen till mappen i textrutan.
När du kör makrot returnerar det Filnamn, Filväg, Filstorlek, Skapat datum och Senast ändrat av alla filer i mappen.
Logisk förklaring
I den här artikeln har vi skapat två makron "ListFilesInFolder" och "TestListFilesInFolder".
Makroet "ListFilesInFolder" visar detaljer relaterade till alla filer i mappen.
Makroet "TestListFilesInFolder" används för att ange rubriken och kalla "ListFilesInFolder" -makrot.
Kodförklaring
Ange FSO = CreateObject ("Scripting.FileSystemObject")
Ovanstående kod används för att skapa ett nytt objekt för filsystemobjekt.
Ange SourceFolder = FSO.GetFolder (SourceFolderName)
Ovanstående kod används för att skapa ett objekt i mappen som anges av sökvägen.
Celler (r, 1) .Formula = FileItem.Name
Celler (r, 2) .Formula = FileItem.Path
Celler (r, 3) .Formula = FileItem.Size
Celler (r, 4) .Formula = FileItem.DateCreated
Celler (r, 5) .Formula = FileItem.DateLastModified
Ovanstående kod används för att extrahera detaljer om filerna.
För varje undermapp i SourceFolder.SubFolders
'Ringer samma procedur för undermappar
ListFilesInFolder SubFolder.Path, True
Nästa undermapp
Ovanstående kod används för att extrahera detaljer om alla filer i undermappar.
Kolumner ("A: E"). Välj
Selection.ClearContents
Ovanstående kod används för att radera innehåll från kolumn A till E.
Följ koden nedan
Alternativ 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' Creating object of FileSystemObject Set FSO = CreateObject ("Scripting .FileSystemObject ") Ange SourceFolder = FSO.GetFolder (SourceFolderName) r = Range (" A65536 "). Slut (xlUp) .Rad + 1 för varje FileItem i SourceFolder.Files 'Visningsfilegenskaper Celler (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 Nästa FileItem 'Skaffa filer i undermappar Om IncludeSubfolders Sedan för varje undermapp i SourceFolder.SubFolders' Anropa samma procedur för undermappar ListFilesInFolder SubFolder.Path, True Next SubFolder End If Set FileItem = Nothing Set SourceFolder = Nothing Set FSO = Nothing ActiveWorkbook.Saved = True End Sub Sub TestListFilesInFolder () 'Declaring variable Dim FolderPath As String' Inaktivera skärmuppdateringar Application.ScreenUpdating = False 'Hämta mappvägen från textrutan FolderPath = Sheet1.TextBox1.Value ActiveSheet.Activate' Rensa innehållet från kolumner A: E Kolumner ("A: E"). Välj Selection.ClearContents Adding headers Range ("A14"). Formel = "Filnamn:" Range ("B14"). Formel = "Path:" Range ("C14"). Formel = "Filstorlek:" Område ("D14"). Formel = "Datum skapat:" Område ("E14"). Formel = "Datum senast ändrat:" "Formering av rubrikerna (" A14: E14 "). Teckensnitt .Bold = True 'Calling ListFilesInFolder makro ListFilesInFolder FolderPath, True' Justerar automatiskt storleken på kolumnerna Kolumner ("A: E"). Välj Selection.Columns.AutoFit Range ("A1"). Välj End Sub
Om du gillade den här bloggen, dela den med dina vänner på Facebook. Du kan också följa oss på Twitter och Facebook.
Vi vill gärna höra från dig, låt oss veta hur vi kan förbättra vårt arbete och göra det bättre för dig. Skriv till oss på e -postwebbplatsen