Dans cet article, nous allons créer une macro pour répertorier tous les fichiers du dossier.

ArrowMain

Lors de l’exécution de la macro, le nom du fichier ainsi que le chemin du fichier s’afficheront à partir de la cellule A17.

ArrowOutput

Explication logique

Dans cet article, nous avons créé deux macros, «subfolder_files» et «getting_filelist_in_folder».

La macro «subfolder_files» prend le chemin du dossier et la valeur booléenne comme entrées et renvoie le nom du fichier dans le dossier.

«Getting_filelist_in_folder» est utilisé pour appeler la macro «subfolder_files». Il fournit la valeur du chemin du dossier à la macro, avec la valeur booléenne définie sur «true». De plus, lorsque des noms de fichiers dans les sous-dossiers sont requis, nous attribuons la valeur booléenne «true».

Explication du code

folder_path = Sheet1.TextBox1.Value Le code ci-dessus est utilisé pour extraire la valeur de chaîne de la zone de texte.

Appelez subfolder_files (folder_path, True)

Le code ci-dessus est utilisé pour appeler la macro «subfolder_files». Il attribue le chemin du dossier et définit la propriété «include_subfolder» sur true.

Définir fso = CreateObject (« scripting.filesystemobject »)

Le code ci-dessus est utilisé pour créer un objet du système de fichiers.

Définir subfolder1 = fso.getfolder (chemin_dossier)

Le code ci-dessus est utilisé pour créer l’objet du dossier défini.

Pour chaque dossier1 Dans subfolder1.subfolders Appelez subfolder_files (folder1, True)

Suivant Le code ci-dessus est utilisé pour parcourir tous les sous-dossiers, dans le dossier principal.

Dir (chemin_dossier1 & « * .xlsx »)

Le code ci-dessus est utilisé pour obtenir le nom du fichier Excel.

Alors que le nom de fichier <> «  »

count1 = count1 + 1 ReDim Preserve filearray (1 To count1)

filearray (count1) = nom de fichier filename = Dir ()

Wend Le code ci-dessus est utilisé pour créer un tableau, qui se compose de tous les noms de fichiers présents dans le dossier.

Pour i = 1 To UBound (filearray)

Cellules (lastrow, 1) .Value = folderpath1 & filearray (i)

lastrow = lastrow + 1 Next Le code ci-dessus est utilisé pour attribuer un nom de fichier dans le tableau au classeur.

Veuillez suivre ci-dessous pour le code

Option Explicit

Sub subfolder_files(folderpath1 As Variant, Optional include_subfolder As Boolean)

'Checking whether to include subfolder or not

If include_subfolder Then



'Declaring variables

Dim filename, filearray() As String

Dim lastrow, count1, i As Integer



'Checking whether folder path contain backslash as last character

If Right(folderpath1, 1) <> "\" Then

folderpath1 = folderpath1 & "\"

End If



'Getting the filename of the first file in the defined folder path

filename = Dir(folderpath1 & "*.xlsx")



'Getting the row number of last cell

lastrow = ActiveCell.SpecialCells(xlCellTypeLastCell).Row + 1



count1 = 0



'Looping through all the files in the folder

While filename <> ""

count1 = count1 + 1

ReDim Preserve filearray(1 To count1)

filearray(count1) = filename

filename = Dir()

Wend



On Error GoTo last



'Adding file name to workbook

For i = 1 To UBound(filearray)

Cells(lastrow, 1).Value = folderpath1 & filearray(i)

lastrow = lastrow + 1

Next



End If

last:

End Sub

Sub getting_filelist_in_folder()

'Declaring variables

Dim folder_path As String

Dim fso As Object, folder1, subfolder1 As Object

'Getting path of the folder

folder_path = Sheet1.TextBox1.Value

'Checking whether folder path contain backslash as last character

If Right(folder_path, 1) <> "\" Then

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)

'Looping through each subfolder

For Each folder1 In subfolder1.subfolders

Call subfolder_files(folder1, True)

Next

End Sub

Si vous avez aimé ce blog, partagez-le avec vos amis sur Facebook et Facebook.

Nous serions ravis de vous entendre, faites-nous savoir comment nous pouvons améliorer notre travail et le rendre meilleur pour vous. Écrivez-nous à [email protected]