Re: Creating folders using VB Script

Tech Tip: Click here to run a free scan for Windows Errors and optimize PC performance

S,
The following worked for me.
'---------------------------------------------------
Sub CreateFoldersInTheFolders()
'Jim Cone - San Francisco, USA - November 2005
'Creates new sub folders in all folders in the specified path.

Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim strPath As String
Dim strFold1 As String
Dim strFold2 As String

strFold1 = "New One"
strFold2 = "New Two"

'Specify the path and folder...
strPath = "C:\Documents and Settings"
Set objFSO = New Scripting.FileSystemObject

objFSO.CreateFolder (strPath & "\" & strFold1)
objFSO.CreateFolder (strPath & "\" & strFold2)

Set objFolder = objFSO.GetFolder(strPath)

'Call recursive function
DoTheSubFolders objFSO, objFolder.SubFolders, strFold1, strFold2

Set objFSO = Nothing
Set objFolder = Nothing
End Sub
'------------------------

Function DoTheSubFolders(ByRef scrFSO As Scripting.FileSystemObject, _
ByRef objFolders As Scripting.Folders, _
ByRef strTitle1 As String, ByRef strTitle2 As String)
Dim scrFolder As Scripting.Folder

For Each scrFolder In objFolders
'Don't want to add new folders to the new folders!
If scrFolder.Name <> strTitle1 And scrFolder.Name <> strTitle2 Then
scrFSO.CreateFolder (scrFolder.Path & "\" & strTitle1)
scrFSO.CreateFolder (scrFolder.Path & "\" & strTitle2)
End If

'If there are more sub folders then go back and run function again.
If scrFolder.SubFolders.Count > 0 Then
DoTheSubFolders scrFSO, scrFolder.SubFolders, strTitle1, strTitle2
End If
Next 'scrFolder

Set scrFolder = Nothing
End Function
'--------------------------------


"Sia.G" <CapitalES@xxxxxxxxx>
wrote...
Hello. I have a small task I need to do at work.
I have to create 2 folders within a folder structure. However I need to
create these 2 folders in EVERY SINGLE existing folder AND their
subfolders.
So let's say we have folders Parent1, Parent2 and Parent3, each has
sub-folders named Sub1 and Sub2. This script needs to create a folder
named New1 and New2 (examples) within all Parents and Subs. Also each
parent doesnt necessarily have 2 sub folders... some have 1, others
have 20.
Anyone know of a good way of doing this?
Cheers!
.

Relevant Pages

  • Re: Extract All the Folders Name form Outlook
    ... These line tell you that the code runs trough all available folders in the ... For Each objFolder In objNS.Folders ... Author of Configuring Microsoft Outlook 2003 ... Dim mlngFolderCount As Long ...
    (microsoft.public.outlook.program_vba)
  • Renaming folders
    ... Dim objFSo As New FileSystemObject ... Dim objFolder As Folder ... 'loop through all folders in this directory ... > recursion in this context ...
    (microsoft.public.excel.programming)
  • Macro for Customized Archiving
    ... from many folders in inbox to different PST folders ... The ArchiveMyMails() routine calls the above multiple times to move ... Dim objInbox As Outlook.MAPIFolder ... Dim objFolder As Outlook.MAPIFolder ...
    (microsoft.public.outlook.program_vba)
  • Re: Size On Disk
    ... Here is some code I wrote a while ago to count the files and folders in any selected drive or folder and report the number of files and folders found together with their total file size and their total size on disk. ... Private Declare Sub CopyMemory Lib "kernel32" _ ... ByVal sDir As String) As Long ... Dim s1 As String, sectorsPerCluster As Long ...
    (microsoft.public.vb.general.discussion)
  • Re: Extract All the Folders Name form Outlook
    ... Please find my Puplic folders Tree: ... Author of Configuring Microsoft Outlook 2003 ... Dim mlngFolderCount As Long ... Dim objFolder As Outlook.Folder ...
    (microsoft.public.outlook.program_vba)