View Full Version : Solved: Creation of Folders and Sub-Folder
iwelcomesu
07-27-2011, 03:36 AM
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
07-27-2011, 04:28 AM
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
07-27-2011, 05:52 AM
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
07-27-2011, 08:23 AM
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
07-27-2011, 08:40 AM
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
07-27-2011, 09:10 AM
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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.