Create Folders and Subfolders using VBS - vbscript

Question

I want to be able to create a set amount of folders and subfolders within a directory. I already have a code that loops through and creates the folders and subfolders. Is there anyway to create a set amount of these folders? Also I want to be able to create them sequentially. For example I already have 2000 folders in there. I would want to create a thousand more but it would start from 2001 to 3000. I basically want to automate the code i have below so no one has to go in and keep changing the values in the script. Thank you!
Here is the code:
Dim oFSO,Folder
Set oFSO = CreateObject("Scripting.FileSystemObject")
For i = 1001 To 2000
' x=msgbox("Directorie " & i ,64, "MakeDir")
If Not oFSO.FolderExists(i) Then
oFSO.CreateFolder i
End If
If Not oFSO.FolderExists(i & "/Text") Then
oFSO.CreateFolder i & "/Text"
End If
If Not oFSO.FolderExists(i & "/Text") Then
oFSO.CreateFolder i & "/Text"
End If
If Not oFSO.FolderExists(i & "/Text") Then
oFSO.CreateFolder i & "/Text"
End If
If Not oFSO.FolderExists(i & "/TestData") Then
oFSO.CreateFolder i & "/TestData"
End If
Next

Answer 1

Give this a try...
BaseFolder = "C:\temp" 'Root folder to look for/create subfolders in
MaxSize = 5 'the number of characters to allow in folder name
PaddingCharacter = "0" 'padding folder names with zeros for proper sorting
NumFolders = 10 'number of additional folder to create
intStart = GetLastFolder(BaseFolder)
If IsNull(intStart) Then
intStart = 1
Else
'skip
End If
For i = intStart To intStart + NumFolders
strFolderName = BaseFolder & "\" & RightPad( i, MaxSize, PaddingCharacter )
Wscript.Echo strFolderName
CreateFolders(strFolderName)
Next
Function GetLastFolder(strFolder)
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = fso.GetFolder(BaseFolder)
Set subFlds = objFolder.SubFolders
For Each fld in subFlds
s = fld.Name
Next
x=Len(s)
For i=0 to x-1
If Mid(s,i+1,1) = "0" Then
'skip
Else
s = Mid(s,i+1,x)
Exit For
End If
Next
GetLastFolder = s
End Function
Function CreateFolders(i)
Dim oFSO,Folder
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.FolderExists(i) Then
oFSO.CreateFolder i
End If
If Not oFSO.FolderExists(i & "/Text") Then
oFSO.CreateFolder i & "/Text"
End If
If Not oFSO.FolderExists(i & "/Text") Then
oFSO.CreateFolder i & "/Text"
End If
If Not oFSO.FolderExists(i & "/Text") Then
oFSO.CreateFolder i & "/Text"
End If
If Not oFSO.FolderExists(i & "/TestData") Then
oFSO.CreateFolder i & "/TestData"
End If
End Function
Function RightPad( strText, intLen, chrPad )
'Example: RightPad( "1000", 7, "0" ) = "0001234"
'Example: RightPad( "1000", 4, "0" ) = "1000"
RightPad = Right( String( intLen, chrPad ) & strText, intLen )
End Function