Listează fișierele dintr-un folder folosind VBA în Microsoft Excel

Cuprins

În acest articol, vom crea o macro pentru a lista toate fișierele din dosar.

La rularea macro-ului, numele fișierului împreună cu calea fișierului vor fi afișate începând cu celula A17.

Explicație logică

În acest articol am creat două macrocomenzi, „subfolder_files” și „getting_filelist_in_folder”.
Macrocomanda „subfolder_files” ia calea folderului și valoarea booleană ca intrări și returnează numele fișierului în dosar.

„Getting_filelist_in_folder” este folosit pentru a apela macro-ul „subfolder_files”. Oferă valoarea căii folderului către macro, cu valoarea booleană setată „true”. De asemenea, atunci când sunt necesare nume de fișiere din subdosare, atunci atribuim valoarea booleană „adevărat”.

Explicarea codului

folder_path = Sheet1.TextBox1.Value
Codul de mai sus este utilizat pentru a extrage valoarea șirului din caseta de text.

Apelați subfolder_files (folder_path, True)
Codul de mai sus este utilizat pentru a apela macro-ul „subfolder_files”. Atribuie calea folderului și setează proprietatea „include_subfolder” adevărată.

Setați fso = CreateObject ("scripting.filesystemobject")
Codul de mai sus este utilizat pentru a crea obiectul sistemului de fișiere.

Set subfolder1 = fso.getfolder (folder_path)
Codul de mai sus este utilizat pentru a crea obiectul folderului definit.

Pentru fiecare folder 1 În subfolder1.subfolders
Apelați subfolder_files (folder1, True)
Următorul
Codul de mai sus este folosit pentru a căuta prin toate sub-folderele, din folderul principal.

Dir (folderpath1 & "* .xlsx")
Codul de mai sus este utilizat pentru a obține numele fișierului excel.

În timp ce numele fișierului ""
count1 = count1 + 1
ReDim Preserve filearray (1 To count1)
filearray (count1) = nume de fișier
filename = Dir ()
Merge încet

Codul de mai sus este utilizat pentru a crea o matrice, care constă din toate numele fișierelor prezente în dosar.

For i = 1 To UBound (filearray)
Celule (lastrow, 1). Valoare = folderpath1 & filearray (i)
lastrow = lastrow + 1
Următorul

Codul de mai sus este utilizat pentru a atribui numele fișierului în matrice registrului de lucru.

Vă rugăm să urmați codul de mai jos

 Option Explicit Sub subfolder_files (folderpath1 As Variant, Optional include_subfolder As Boolean) 'Verificarea dacă trebuie să includă subfolderul sau nu Dacă include_subfolder Apoi' Declararea variabilelor Dim fișier nume, filearray () Ca șir Dim ștergere, numărare1, i Ca întreg 'Verificarea dacă calea folderului conține backslash ca ultimul caracter If Right (folderpath1, 1) "\" Then folderpath1 = folderpath1 & "\" End If 'Obținerea numelui de fișier al primului fișier în calea folderului definit nume de fișier = Dir (folderpath1 & "* .xlsx")' Obținerea numărului de rând al ultimei celule lastrow = ActiveCell.SpecialCells (xlCellTypeLastCell). Rând + 1 count1 = 0 'Buclarea prin toate fișierele din folder În timp ce numele fișierului "" count1 = count1 + 1 ReDim Preserve filearray (1 To count1) filearray ( count1) = nume fișier nume fișier = Dir () Eroare Wend On GoTo last 'Adăugarea numelui fișierului în registrul de lucru Pentru i = 1 La UBound (filearray) Celule (lastrow, 1). Valoare = folderpath1 & filearray (i) lastrow = lastrow + 1 Next End If last: End Sub Sub getting_filelist_in_folder () 'Declararea variabilelor Dim folder_path As String Dim fso As Object, folder1, subfolder1 As Object' Obținerea căii folderului folder_path = Sheet1.TextBox1.Value 'Verificarea dacă calea folderului conține backslash ca ultimul caracter Dacă Right (folder_path, 1) " \ "Then folder_path = folder_path &" \ "End If 'Calling subfolder_files macro Apelați subfolder_files (folder_path, True)' Crearea obiectului obiectului Sistem de fișiere Set fso = CreateObject (" scripting.filesystemobject ") Set subfolder1 = fso.getfolder (folder_path) 'Buclarea prin fiecare subfolder pentru fiecare folder1 În subfolder1.subfoldere Apelați subfolder_files (folder1, True) Următorul sfârșit 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

Vei ajuta la dezvoltarea site-ului, partajarea pagina cu prietenii

wave wave wave wave wave