Create SubFolders after Root Folder is created from xls file

Hello, I am trying to create subfolders underneath a root folder. I have say 10000 folders being created fine using the attached code.I am trying to figure out how to have subfolders created under each folder I have created using the excel spreadsheet data.

This is the structure i am looking to acheive.

Clients\10000\
                     10001\
                              SubFolder ( not part of xls data) just a folder that I will name
                              perhaps more subfolders here as well

So my code so far takes the data from xls and creates the 10000 folders i want.Underneath each of these 10000 folders I want to create other folders for each.

The bottom code snippet is what I am thinking but cant seem to get it right... can anyone help at all..


Thanks Very much
   
strComputer = "." 
 
strRoot = "z:\clients\10000\"
 
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") 
 
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\Scripts\Clients10.xls") 
objExcel.Visible = False 
 
i = 1 
 
Do Until objExcel.Cells(i, 1).Value = ""     
    strNewFolderName = objExcel.Cells(i, 1).Value
    
 
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 Set objFolder = objFSO.CreateFolder(strRoot & strNewFolderName) 
	
 
    
 
    i = i + 1
Loop 
 
 objExcel.quit
 
-------------------
Set objFolder=objFSO.GetFolder(strRoot & strFolder)
Set colFolders=objFolder.SubFolders
arrFolders=Array("SubFolder1","SubFolder2","SubFolder3")
 
For Each item In arrFolders
    If objFSO.FolderExists(strRoot & strFolder & "\" & item) Then
        WScript.Echo "Folder " & strRoot & strFolder &_
         "\" & item & " already exists"
    Else
        colFolders.Add item
    End If

Open in new window

OttawayaAsked:
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

x
 
Shift-3Connect With a Mentor Commented:
Assuming that I am understanding your intention correctly, this should do it.


Set objFolder=objFSO.GetFolder(strRoot)
Set colFolders=objFolder.SubFolders
arrFolders=Array("SubFolder1","SubFolder2","SubFolder3")
 
For Each objSub in colFolders
    For Each item In arrFolders
        If objFSO.FolderExists(objSub.Path & "\" & item) Then
            WScript.Echo objSub.Path & "\" & item & " already exists"
        Else
            objFSO.CreateFolder objSub.Path & "\" & item
        End If
    Next
Next

Open in new window

0
 
RobSampsonCommented:
Hi, perhaps a function like this would help?

Regards,

Rob.
Set objFSO = CreateObject("Scripting.FileSystemObject")
strPath = "C:\Temp\Folder1\Folder2"
If objFSO.FolderExists(strPath) = False Then CreateLocalDirectoryStructure strPath
 
Sub CreateLocalDirectoryStructure(strPath)
	If Right(strPath, 1) = "\" Then strPath = Left(strPath, Len(strPath) - 1)
	arrBits = Split(strPath, "\")
	strSubPath = arrBits(0)
	If UBound(arrBits) > 0 Then
		For intBit = 1 To UBound(arrBits)
			strSubPath = strSubPath & "\" & arrBits(intBit)
			If objFSO.FolderExists(strSubPath) = False Then objFSO.CreateFolder(strSubPath)
		Next
	End If
End Sub

Open in new window

0
 
OttawayaAuthor Commented:
This is exactly what i was looking for I just appened it to ,y current script and volia.. all folders are there. I was on the right track.nest for loops i guess is the answer. I will ping back when i need more.. I have to now migrate data to these folders.. grr thats going to be a bigger task...

Thanks Much Shift-3
0
All Courses

From novice to tech pro — start learning today.