I den här artikeln kommer vi att skapa ett makro för att lista alla filer i mappen.
När du kör makrot visas filnamnet tillsammans med sökvägen från cell A17.
Logisk förklaring
I den här artikeln har vi skapat två makron, "undermapp_filer" och "att få_filelist_in_mapp".
Makroet "undermapp_filer" tar mappsökvägen och det booleska värdet som inmatningar och returnerar filnamnet i mappen.
"Getting_filelist_in_folder" används för att kalla makrot "undermapp_filer". Det ger mappvägsvärdet till makrot, med booleskt värde som satt 'true'. När filnamn i undermapparna krävs tilldelar vi booleskt värde 'true'.
Kodförklaring
folder_path = Sheet1.TextBox1.Value
Ovanstående kod används för att extrahera strängvärde från textrutan.
Ringa undermapp_filer (mappväg, True)
Ovanstående kod används för att kalla makrot "undermapp_filer". Den tilldelar mappsökvägen och ställer in "include_subfolder" -egenskapen true.
Ange fso = CreateObject ("scripting.filesystemobject")
Ovanstående kod används för att skapa objekt för filsystemet.
Ange undermapp1 = fso.getfolder (mappväg)
Ovanstående kod används för att skapa objektet för den definierade mappen.
För varje mapp1 I undermapp1. Undermappar
Ringa undermapp_filer (mapp1, sant)
Nästa
Ovanstående kod används för att titta igenom alla undermappar i huvudmappen.
Dir (folderpath1 & "*.xlsx")
Ovanstående kod används för att få Excel -filnamnet.
Medan filnamnet ""
count1 = count1 + 1
ReDim Preserve filearray (1 att räkna1)
filearray (count1) = filnamn
filnamn = Dir ()
Wend
Ovanstående kod används för att skapa en array, som består av alla filnamn som finns i mappen.
För i = 1 Till UBound (filarrray)
Celler (lastrow, 1) .Value = folderpath1 & filearray (i)
lastrow = lastrow + 1
Nästa
Ovanstående kod används för att tilldela arbetsboken filnamn i matrisen.
Följ koden nedan
Alternativ Explicit Undermapp_filer (mappväg1 som variant, Valfritt inkludera_undermapp som boolsk) 'Kontrollera om mapp ska inkluderas eller inte Om inkludera_katalog Därefter' Deklarerande variabler Dim filnamn, filearray () As String Dim lastrow, count1, i As Integer 'Kontrollera om mappens sökväg innehåller backslash som sista tecken If Right (folderpath1, 1) "\" Then folderpath1 = folderpath1 & "\" End If 'Skaffa filnamnet för den första filen i den definierade mappvägen filnamn = Dir (folderpath1 & "*.xlsx")' Få radnumret för sista cellen lastrow = ActiveCell.SpecialCells (xlCellTypeLastCell) .Rad + 1 count1 = 0 'Bläddra igenom alla filer i mappen Medan filnamn "" count1 = count1 + 1 ReDim Preserve filearray (1 To count1) filearray ( count1) = filnamn filnamn = Dir () Wend On Error Gå till sista 'Lägga till filnamn i arbetsbok För i = 1 Till UBound (filearray) Celler (lastrow, 1) .Value = folderpath1 & filearray (i) lastrow = lastrow + 1 Next Slut Om sist: Slut Sub Sub får_filelist_in_mapp () 'Declaring variables Dim folder_path As String Dim fso As Object, folder1, subfolder1 As Object' Hämtar sökväg för mappen folder_path = Sheet1.TextBox1.Value 'Kontrollerar om mappvägen innehåller bakåtstreck som sista tecknet If Right (folder_path, 1) " \ "Sedan folder_path = folder_path &" \ "End If 'Calling subfolder_files macro Call subfolder_files (folder_path, True)' Creating object of File system object Set fso = CreateObject (" scripting.filesystemobject ") Set subfolder1 = fso.getfolder (folder_path) 'Bläddra igenom varje undermapp För varje mapp1 I undermapp1.kataloger Anropa undermapp_filer (mapp1, sant) Nästa slutsub
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
