View Full Version : Solved: Add Sub-Folders

03-13-2009, 08:32 PM
Hi Everybody,

I have a directory which has 300+ folders
I have to change the structure I mean insert 5 sub-folders in all the 300+ folders

Is there a way I can modify this code to add the sub-folders listed in Excel to automatically include in all those 300+ folders.

Public Sub ProcessData()
Const ROOT_FOLDER As String = "C:\myDir\"
Dim LastRow As Long
Dim i As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

On Error Resume Next
For i = 1 To LastRow

MkDir ROOT_FOLDER & .Cells(i, "A").Value
Next i
On Error GoTo 0
End With

End Sub

Any ideas
Thanks & Best regards

Kenneth Hobs
03-13-2009, 09:00 PM
If you want to insert 5 subfolder in each of the 300, where are they? Are the in column A? A bit more detail is needed.

03-13-2009, 09:11 PM
The names of the 5 folders will be listed in column A

03-13-2009, 09:38 PM
Greetings parttime,

Just checking. After creating folders, are you going to need to (programatically) insert files, or, do you just need to create the empty folders?


03-13-2009, 10:03 PM

I just need to create empty folders, as listed in Column A. The problem is inserting sub-folders into those 300+ directories. Iam just trying to customise those 300+ main folders (eg. doc, wks, others are sub-folders) - I would insert doc, wks, others in the worksheet in Column A - I run the vba code and doc, wks, others gets inserted in all the 300+ directories.

Iam stuck, otherwise I would mannually have to include doc, wks, others into 300+ directories seperately.

As to moving & inserting the files that is seperate issue - I just need empty sub-folders as doc, wks, others as listed in the worksheet - there could be more than 10 sub-folders. Basically Iam just trying to get a common folder structure for all the 300+ directories.

Hey Kenneth & GTO thanks for taking interest.

Best regards

03-13-2009, 10:18 PM
Hi parttime,

Please note I changed the Const to a folder on my flash for testing. Also - I just used Array("folder1", etc ) for the five new names.

I don't see anything to go wrong, but that's a lot of subfolders to delete if any mistakes, so I would be extra careful in assigning the Const. I'm sure you've already thought of that though.

In a standard module:

Option Explicit

Sub SubFolders_Create()

Dim _
fso As Object, i As Long, _
fol_root As Object, aryNewFolders(), _
fol As Object

'// Change to suite. (I would sure wanna be sure - dang //
'// lotta subdirectories to delete if wrong... //
Const ROOT_FOLDER As String = "G:\021209" '"C:\myDir\"
Set fso = CreateObject("Scripting.FileSystemObject")
Set fol_root = fso.GetFolder(ROOT_FOLDER)
'// Names of five sub folders here//
aryNewFolders = Array("Monday", "Tuesday", "Wednesday", "Thursday", "Friday")

For Each fol In fol_root.SubFolders
For i = LBound(aryNewFolders()) To UBound(aryNewFolders())
On Error Resume Next

fol.SubFolders.Add aryNewFolders(i)

If Not Err.Number = 0 Then
If MsgBox("Folder: " & fol.Path & "\" & aryNewFolders(i) & _
" already exists. <OK> to continue, <Cancel> to quit.", _
vbExclamation + vbOKCancel, "") = vbOK Then
Exit Sub
End If
End If
End Sub

Hope this helps,


03-13-2009, 10:27 PM
Hey GTO "Boss",

It works like magic,
& now I know who the magician around here!.

That code is really going to make life a lot easy.
Thanks once again - I owe u one more...:thumb

03-13-2009, 10:38 PM
Hey GTO "Boss",

It works like magic,
& now I know who the magician around here!.

Shucks, no magician here. I usually test my code by taking a long stick and poking at F5 thru an open window...:hide:

Happy to help :hifive: