vb script to create folder and copy other folders into it

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

Select allOpen in new window