Folder script 2

[ITSTOAST]

Hi all I have this script that I need to change so that it has a wild card function allowing it to create a folder in all the folders within one folder, my script so far is:

On Error Resume Next

Dim Answer1, Answer2, Answer3

Set wn = WScript.CreateObject("WScript.Network")
Set fs = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("WScript.Shell")

Answer1 = InputBox("Enter the name of the folder you wish to create")



' The following lines will create a folder and two
' subfolders on c: from the answers given in the input
' boxes above

fs.CreateFolder ("d:\pupils\all\my documents\tech\year 5\" & Answer1)






Only the good die young, me I'm here forever

 

[antykreist]

Try this ITSTOAST:

	Dim fso 
	Dim path
	Dim oFolder
	Dim oSubFolder
	Dim oSHA
	Const OverwriteExisting = True
	Set oSHA=CreateObject("Shell.Application")

	transfer =BrowseForFolder("Select the folder containing files to transfer:")

	Path=BrowseForFolder("Select Target Folder:")

	Set fso = createobject("Scripting.FileSystemObject")
	Folder = transfer & "\*"

	Set oFolder = fso.GetFolder(Path)
	Set colSubfolders = oFolder.Subfolders

	For Each oSubfolder in colSubfolders
		fso.CopyFolder Folder, path & "\" & oSubFolder.Name & "\", OverwriteExisting    
	Next

Function BrowseForFolder(sPrompt)
	Const ShowAllObjects=1
	Const ShowExtensions=2
	Const MyComputer=17
	Dim lShow,oFldr,sPath
	lShow=ShowAllObjects Or ShowExtensions
	Set oFldr=oSHA.BrowseForFolder(&0,sPrompt,lShow,MyComputer).Self
	sPath=oFldr.Path
	If Right(sPath,1)<>"\" Then sPath=sPath&"\"
	BrowseForFolder=sPath
End Function

 

[ITSTOAST]

THANKS

Only the good die young, me I'm here forever