Need to Create Many Folders and SubFolders With less than a Minute.
Below is the solution to your problem.
Sub CreateFoldersandSubFolders()
'Execute next line in case of error.
On Error Resume Next
'Loop through all the cells in column 1 in Active Sheet.
For i = 1 To ActiveSheet.UsedRange.Rows.Count
'Name of the Folder
sFolderPath = ThisWorkbook.Path & "\" & Cells(i, 1) 'Replace This.Workbook.Path with any location Example "C:\" & Cells(i,1)
'Creating Folder Using Shell Function
Shell "cmd /c mkdir """ & sFolderPath & """", vbHide 'It will Execute Dos Command and use MKDIR to Make Directory of sFolderPath Value
'To continue the Loop
Next i
'Displaying Message
MsgBox "Folders Created"
End Sub
See it in Action.
Below is the solution to your problem.
Sub CreateFoldersandSubFolders()
'Execute next line in case of error.
On Error Resume Next
'Loop through all the cells in column 1 in Active Sheet.
For i = 1 To ActiveSheet.UsedRange.Rows.Count
'Name of the Folder
sFolderPath = ThisWorkbook.Path & "\" & Cells(i, 1) 'Replace This.Workbook.Path with any location Example "C:\" & Cells(i,1)
'Creating Folder Using Shell Function
Shell "cmd /c mkdir """ & sFolderPath & """", vbHide 'It will Execute Dos Command and use MKDIR to Make Directory of sFolderPath Value
'To continue the Loop
Next i
'Displaying Message
MsgBox "Folders Created"
End Sub
See it in Action.
Very Helpful and informative for me. Find and Replace in Excel tool with additional features
ReplyDeleteThank you!! Very helpful.
ReplyDeleteGood thank you...
ReplyDeleteVery helpful and it works for me. I adapted it to my needs. Thanks!
ReplyDeletealmost 3 years later from this post, it was very useful, thanks a lot for share the knowledge and many greetings from México :D
ReplyDeleteAbsolutely excellent. Thanks. Most appreciate.
ReplyDelete