Solved: Add Sub-Folders

[parttime_guy]

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.

[vba]
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
[/vba]


Any ideas
Thanks & Best regards

[Kenneth Hobs]

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.

[parttime_guy]

The names of the 5 folders will be listed in column A

[GTO]

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?

Mark

[parttime_guy]

Hi GTO,

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

[GTO]

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:

[vba]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
Err.Clear

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
'nothing
Else
Exit Sub
End If
End If
Next
Next
End Sub[/vba]

Hope this helps,

Mark

[parttime_guy]

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...

[GTO]

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...


Happy to help