How to create multiple subfolders using VBA

[ScottMsp]

Hello and thanks for reading my question.

I need some VBA programming help.

I have a main folder with subfolders in it. I want to add a new subfolder
to each subfolder in the directory.

It would look something like this

Main Folder
Subfolder1
NewSubfolder
Subfolder2
NewSubfolder
Subfolder3
NewSubfolder
Subfolder4
NewSubfolder

I was able to use this VBA to do it for one folder, but I need it to look
through all Subfolders

MkDir ("C:\MainFolder\Subfolder1\Subfolder1.1")

How do I look through each subfolder and add a new subfolder under each
subfolder?

Thanks in advance.

 

[Dave Peterson]

Just make the subfolders in order:

on error resume next 'in case the folder already exists
mkdir "C:\mainfolder"
mkdir "C:\mainfolder\subfolder1"
mkdir "C:\mainfolder\subfolder1\newsubfolder1"
mkdir "C:\mainfolder\subfolder1\newsubfolder2"
mkdir "C:\mainfolder\subfolder2"
mkdir "C:\mainfolder\subfolder2\newsubfolder1"
mkdir "C:\mainfolder\subfolder2\newsubfolder2"
....

 

[ScottMsp]

Dave,

My problem is that I have over 1,000 folders that I need to make. I presume
there is a more effecient way than creating over 1,000 lines of code?

Thanks in advance.

 

[Brad]

I have not tried this with VBA, but I have done it with AutoCAD. You could
use Excel to write the code. The main trick is to use concatenation to
build up the single lines of code, and then copy the column with the
concatenated cells to your macro.

Brad

Excel 2002 on XP Pro SP 3
Excel 2007 on Vista 64

 

[Steve Yandl]

You could use the scripting file system object. You didn't elaborate on any
naming convention. The example below takes each subfolder of "C:\Test" and
creates a new second level subfolder named "newSub" in it if such a
subfolder doesn't already exist.

Steve

'----------------------------------------
Sub MakeManySubs()
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder("C:\Test")
For Each subF In f.Subfolders
If Not fso.FolderExists(subF & "\newSub") Then
fso.CreateFolder (subF & "\newSub")
End If
Next subF
Set fso = Nothing
End Sub


'---------------------------------------

 

[Dave Peterson]

You could set up a loop, but you didn't share enough info to do that.

You could put the folder names in a worksheet (A1:A1000) and loop through that.