vb script to create folder and copy other folders into it

clynch302
clynch302 used Ask the Experts™
on
Hello all -
I am no programmer and looking for a vb script that when a user runs it, it will ask the user for a name of the folder then create the folder. Then copy all folders (only folders) from another directory into the newly created folder. I do not need the files that are in the folders being copied, just the folders. We are in a Windows environment.

Thanks
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Meir RivkinFull stack Software Engineer

Commented:
dim srcFodler, destFodler ,filesys,objFolderSrc
srcFodler = UserInput( "Enter source folder:" )
destFodler = UserInput( "Enter destination folder:" )

set filesys = CreateObject("Scripting.FileSystemObject")

If  Not filesys.FolderExists(destFodler) Then
	CreateDirs destFodler
 else
	objFolder = filesys.GetFolder(destFodler)
End If

set objFolderSrc = filesys.GetFolder(srcFodler)
ShowSubFolders objFolderSrc

Sub ShowSubFolders(objFolder)
	dim folderName
	Set colFolders = objFolder.SubFolders

  For Each objSubFolder In colFolders
 
  	folderName = Replace(objSubFolder.Path, srcFodler, destFodler)

    CreateDirs folderName
    
    ShowSubFolders(objSubFolder)
  Next

End Sub

Function UserInput( myPrompt )
    ' Check if the script runs in CSCRIPT.EXE
    If UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" Then
        ' If so, use StdIn and StdOut
        WScript.StdOut.Write myPrompt & " "
        UserInput = WScript.StdIn.ReadLine
    Else
        ' If not, use InputBox( )
        UserInput = InputBox( myPrompt )
    End If
End Function

Sub CreateDirs( MyDirName )

    Dim arrDirs, i, idxFirst, objFSO, strDir, strDirBuild

    ' Create a file system object
    Set objFSO = CreateObject( "Scripting.FileSystemObject" )

    ' Convert relative to absolute path
    strDir = objFSO.GetAbsolutePathName( MyDirName )

    ' Split a multi level path in its "components"
    arrDirs = Split( strDir, "\" )

    ' Check if the absolute path is UNC or not
    If Left( strDir, 2 ) = "\\" Then
        strDirBuild = "\\" & arrDirs(2) & "\" & arrDirs(3) & "\"
        idxFirst    = 4
    Else
        strDirBuild = arrDirs(0) & "\"
        idxFirst    = 1
    End If

    ' Check each (sub)folder and create it if it doesn't exist
    For i = idxFirst to Ubound( arrDirs )
        strDirBuild = objFSO.BuildPath( strDirBuild, arrDirs(i) )
        If Not objFSO.FolderExists( strDirBuild ) Then
            objFSO.CreateFolder strDirBuild
        End if
    Next

    ' Release the file system object
    Set objFSO= Nothing
End Sub

Open in new window


i used the following links:
http://blogs.msdn.com/b/gstemp/archive/2004/08/10/212113.aspx
http://www.robvanderwoude.com/vbstech_ui_userinput.php
Full stack Software Engineer
Commented:
the source folder is from where to copy the sub folders.
the destination folder is where to copy the sub folders.

for instance if the source folder tree is:

c:\temp
c:\temp\config
c:\temp\apps
c:\temp\apps\tomcat
c:\temp\apps\vs

and destination folder is c:\vbs\test

after running the script the destination folder tree should be:
c:\vbs\test
c:\vbs\test\config
c:\vbs\test\apps
c:\vbs\test\apps\tomcat
c:\vbs\test\apps\vs

Author

Commented:
Thanks - I was able to use your example and create a working script

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial