Creating a text file to unknown folders

The following code creates a text file in the directory that I specify.

Dim dateiname As String, dateinr As Integer
DirPath = "C:\text\"
dateiname = DirPath & textbox1.Text & ".txt"
'Check if path exists and create
If Dir$(DirPath & "\.") = "" Then
MkDir (DirPath)
End If
'go on writing the file
dateinr = FreeFile
Open dateiname For Output As dateinr
Print #dateinr, textbox2.Text
Close dateinr
'eyerything done
MsgBox "File saved to " & dateiname
End Sub

How would I get it to save the file to each separate folder within a
directory? For instance say you had the directory C:\text\ and within that
their were the folders text1, text2 and text3. How would I get the text file
to be saved into each one? Remembering that the app wont know what folders
are in the directory, so it will need to find out somehow.

Thanks,

Jonathon.

'here is a way to look for subfolders provided a path:
option Explicit
'put a reference to microsoft scriting riuntime

private Sub Command1_Click()
Dim fso as Scripting.FileSystemObject
Dim subdir as Scripting.Folder
Dim Foldermain as Scripting.Folder
Dim FolderColl as Scripting.Folders
set fso = new Scripting.FileSystemObject
With fso
set Foldermain = .GetFolder("C:\text") 'the main dir
set FolderColl = Foldermain.SubFolders
for Each subdir In FolderColl
MsgBox subdir.Path
'here put your copying code
next
End With
set FolderColl = nothing
set Foldermain = nothing
set fso = nothing
End Sub





Special thanks to Lothar "the Great" Haensler, Tom Archer, Chris Eastwood, TCartwright, Bruno Paris, Dr_Michael
and all the other wonderful people who made and make Codeguru a great place.
Come back soon, you Gurus.

The Rater

Thanks Cimperiali,

That works great!

Jonathon.