Zadig said:
Hi Torgeir....(Porsgrunn er sikkert en fin by)
This did the trick, except it didn't do the trick in ALL the
subfolders. Just the subfolders on the root level.
But this is what I've been looking for.
You see the folders for each country are located as a subfolder
to each parts of the world like this
The news in Buskerud would be found in C:\The World\Europe\
Norway\Buskerud\ And under these folders i.e. C:\The World\ and
C.\The World\Europe\ and C:\The World\Europe\ and C:\The World\
Europe\Norway\ and C:\The World\Europe\Norway\Buskerud\ I want
to add the subfolders of my choice.
This is just a start page idea I will make available free to
anyone on my website if I get it right
Hi,
Ok, maybe I will succeed on my third try
Below are two different scripts.
The first one will create the folders defined in the aNewFolders array
variable in *all* existing folders starting with the folder defined in
the sBaseFolder variable and all it's subfolders.
The second script is a version that will create new folders only at
the subfolder level count specified in the iSubfolderLevel variable.
First script:
'--------------------8<----------------------
' Script that will populate new folders in all existing folders
' starting with the folder defined in the sBaseFolder variable
' and all it's subfolders.
' Define the base folder path
sBaseFolder = "C:\The World"
' list all new folders to be created here,
' new1/new2/new3 is just example names you need to change
aNewFolders = Array("new1", "new2", "new3")
Set oFSO = CreateObject("Scripting.FileSystemObject")
Call CreateFolders(sBaseFolder)
MsgBox "Finished!", vbInformation + vbSystemModal, "Populate folders"
Sub CreateFolders(sFolder)
Set oFolder = oFSO.GetFolder(sFolder)
' enumerate all the subfolders
For Each sFldr In oFolder.SubFolders
CreateFolders sFldr
Next
For Each sNewFolder In aNewFolders
If Not oFSO.FolderExists(sFolder & "\" & sNewFolder) Then
oFSO.CreateFolder sFolder & "\" & sNewFolder
End If
Next
End Sub
'--------------------8<----------------------
Second script:
'--------------------8<----------------------
' Script that will create new folders only at the subfolder level
' count specified in the iSubfolderLevel variable.
' Define the base folder path
sBaseFolder = "C:\The World"
' Defining at what subfolder level the new folders are to be created
' If you set it to 0, the folders will be created in the base folder
iSubfolderLevel = 3
' list all new folders to be created here,
' new1/new2/new3 is just example names you need to change
aNewFolders = Array("new1", "new2", "new3")
Set oFSO = CreateObject("Scripting.FileSystemObject")
Call CreateFolders(sBaseFolder)
MsgBox "Finished!", vbInformation + vbSystemModal, "Populate folders"
Sub CreateFolders(sFolder)
sRelativePath = Mid(sFolder, Len(sBaseFolder)+1)
If CharCount(sRelativePath, "\") = iSubfolderLevel Then
For Each sNewFolder In aNewFolders
If Not oFSO.FolderExists(sFolder & "\" & sNewFolder) Then
oFSO.CreateFolder sFolder & "\" & sNewFolder
End If
Next
Else
Set oFolder = oFSO.GetFolder(sFolder)
' enumerate all the subfolders
For Each sFldr In oFolder.SubFolders
CreateFolders sFldr
Next
End If
End Sub
Function CharCount(sString, sChar)
If Len(sChar) <> 1 Or sString = "" Then
CharCount = 0 : Exit Function
End If
Select Case sChar
Case "\", "$", "*", "+", "?", ".", "(", ")", "|"
sChar = "\" & sChar
End Select
With New RegExp
.Pattern = sChar
.IgnoreCase = True
.Global = True
CharCount = .Execute(sString).Count
End With
End Function
'--------------------8<----------------------
)