Solved: Creation of Folders and Sub-Folder

[iwelcomesu]

Hi All,

Good Morning, I need to create folders and sub-folders for attached excel sheet.
Requirements.
1. in attached excel sheet column A are the main folders.
2. from cloum B is subfolders and cloumn C is subfolders for cloumn B
3. Macro should ask the location where folders are need to save
Can you please provide any code that solve my problem.

Thanks in advance.

Regards,
Hari

[Bob Phillips]

Public Sub ProcessData()
Dim BaseFolder As String
Dim BaseChild As String
Dim Lastrow As Long
Dim i As Long
Dim cell As Range

Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFolderPicker)

.AllowMultiSelect = False
.Title = "Select base folder"
If .Show = -1 Then

BaseFolder = .SelectedItems(1)

With ActiveSheet

Lastrow = .UsedRange.Rows.Count
For i = 1 To Lastrow

If Cells(i, "B").Value2 <> "" Then

BaseChild = BaseFolder & Application.PathSeparator & .Cells(i, "B").Value2
MkDir BaseChild
End If

If Cells(i, "C").Value2 <> "" Then

MkDir BaseChild & Application.PathSeparator & .Cells(i, "C").Value2
End If
Next i
End With
End If
End With

Application.ScreenUpdating = True
End Sub

[iwelcomesu]

Hi Xld,

Thanks for Quick response, this codes creating from cloumn B and C, my requirement start with cloumn A also, First consider Cloumn A then B and C.

Can you please help!

Regards,
Hari

[shrivallabha]

Gatecrashing this thread but I had once tried my hand at this. Folder creations by Excel. The code I had written, I guess, is flawed as it is pending for approval for long. Anyway, here's the workbook. Write the folder tree in manner specified and you should get what you want.

[Bob Phillips]

Public Sub ProcessData()
Dim BaseFolder As String
Dim BaseChild As String
Dim BaseGrandChild As String
Dim Lastrow As Long
Dim i As Long
Dim cell As Range

Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFolderPicker)

.AllowMultiSelect = False
.Title = "Select base folder"
If .Show = -1 Then

BaseFolder = .SelectedItems(1)

With ActiveSheet

Lastrow = .UsedRange.Rows.Count
For i = 1 To Lastrow

If Cells(i, "A").Value2 <> "" Then

BaseChild = BaseFolder & Application.PathSeparator & .Cells(i, "A").Value2
MkDir BaseChild
End If

If Cells(i, "B").Value2 <> "" Then

BaseGrandChild = BaseChild & Application.PathSeparator & .Cells(i, "B").Value2
MkDir BaseGrandChild
End If

If Cells(i, "C").Value2 <> "" Then

MkDir BaseGrandChild & Application.PathSeparator & .Cells(i, "C").Value2
End If
Next i
End With
End If
End With

Application.ScreenUpdating = True
End Sub

[Kenneth Hobs]

Here is my method. Of course I build off the fine work of others. XLD's also will do as you want if you tweak his to add the Len() check.

Public Sub kenProcessData()
Dim BaseFolder As String
Dim BaseChild As String
Dim Base1 As String, Base2 As String
Dim i As Long
Dim cell As Range
Dim aps As String

aps = Application.PathSeparator
Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Title = "Select base folder"
If .Show = -1 Then
BaseFolder = .SelectedItems(1) & aps
With ActiveSheet
Base1 = Range("A1").Value2
Base2 = Range("B1").Value2
For i = 1 To .UsedRange.Rows.Count
If Len(Range("A" & i).Value2) > 0 Then Base1 = Range("A" & i).Value2
If Len(Range("B" & i).Value2) > 0 Then Base2 = Range("B" & i).Value2
BaseChild = BaseFolder & Base1 & aps & Base2 & aps & Range("C" & i).Value2
Shell "cmd /c md " & """" & BaseChild & """", vbHide
Next i
End With
End If
End With

Application.ScreenUpdating = True
End Sub