Objective
To list the name of folders and subfolder and save output in a file using VBA Excel.
Approach
Here first we have declared folder path in a variable called MyFolderPath, variable MyFolderPath contains the path of the folder which has folders and subfolders, and we wanted to enlist them in a file. Then we have invoked the command prompt in VBA Excel. We have executed the Dir command to find the list of folder and subfolders in the above-mentioned path. Here we have saved the output of Dir command in a csv file called as Directory_Details.csv.Output file Directory_Details.csv is saved at path which is stored in variable MyFolderPath.
Here we have waited for a second in the VBA code, because the output of Dir command comes a bit slower, so by waiting for 1 second, we ensure that the file Directory_Details.csv is created before we open it.
Then we have opened the Directory_Details.csv which is now located at path which is stored in variable MyFolderPath. In this file we have paths of folders in column A. So, our next aim was to separate the folder name from the folder path. Here we have used Mid function to find the folder name from the path. So now we have data in 2 columns, first column contains the path while the second column contains the folder name.
After getting the data in 2 columns we wanted to add header row in the output csv file, so we added a row and added 2 column names in cell A1 and B1.
Now to save the formatting, we have converted the Directory_Details.csv to Directory_Details.xlsx.Then we deleted the Directory_Details.csv.
Code
Sub FindFolderSubFolderNames() Application.DisplayAlerts = False Application.ScreenUpdating = False Dim MyFolderPath As String 'Path where the folder is located, change the path as per your requirement MyFolderPath = "C:\Users\username\Desktop\macro" 'Change the current directory to required folder ChDir MyFolderPath 'Check if the folder already exists or not If Dir(MyFolderPath, vbDirectory) <> "" Then 'List all folders and subfolders using dos command in file directory_details.csv Call Shell("cmd.exe /C" & "dir /s /b /o:n /a:d > Directory_Details.csv " & " /Q") 'Used the wait for 1 sec because output csv is not created that fast Application.Wait (Now + TimeValue("0:00:01")) 'Find the folder name from the path in output file Workbooks.Open Filename:=MyFolderPath & "\" & "Directory_Details.csv" Workbooks("Directory_Details").Activate LastPopulatedRow = Range("A1").End(xlDown).Row For i = 1 To LastPopulatedRow Range("B" & i).Value = Mid(Range("A" & i).Value, InStrRev(Range("A" & i).Value, "\", -1) + 1, Len(Range("A" & i).Value)) Next i Columns("A:B").EntireColumn.AutoFit 'Insert column headers Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("A1").Value = "Folder_Path" Range("B1").Value = "Folder_Name" 'Convert the csv file to xlsx format Workbooks("Directory_Details").SaveAs MyFolderPath & "\" & "Directory_Details.xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False Workbooks("Directory_Details").Close 'Delete previously ceated output csv file Kill MyFolderPath & "\" & "Directory_Details.csv" MsgBox "Folder List created in file Directory_Details.xlsx at path mentioned above " 'Display a message box if folder does not exist Else MsgBox "Folder does not Exist" End If End Sub
In the image below we can see the output in the xlsx file.
Post you may like
How to insert or import multiple jpeg images in excel file using VBA Excel ?
Reference
https://docs.microsoft.com/en-us/windows-server/administration/windows-commands/dir
https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/instrrev-function
https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/mid-function