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
