Rename Folder Structure (Shuffle letters) in VBS

REM   RenameFoldersShuffle.vbs

      REM Rich L

      REM In order to take a folder structure passed in and shuffle all

      REM folders after a given level. Here it's the second level down

     

      REM This is for a Honey Pot whereby we do not want the original

      REM folder's names there. This was in case there are confidental

      REM folders after the [blank] structure was copied from the

      REM source

     

      REM 2016-05-03

 

 

dim arFirstName

on error resume next

  Set oFSO = CreateObject("Scripting.FileSystemObject")

    on error resume next

          Set oFolder = oFSO.GetFolder(wscript.arguments(0))

          Recurse oFolder,0

   Set oFSO = nothing


function CreateString(sString)

  dim aArray()

  redim aArray(0)

   CreateString=""

   for x=1 to len(sString)

     redim preserve aArray(ubound(aArray)+1)

      aArray(ubound(aArray))=Mid(sString,x,1)

   next

   CreateString=aArray

  

end function

Private Sub Shuffle(arData)

  ' Durstenfeld's Permutation Algorithm

  ' Randomly permute the elements of p(1:n) using Durstenfeld's

  ' Random Permutation Algorithm, CACM, Vol 7, No. 7, 1964.

  ' See Knuth, Section 3.4.2, TAOCP, Vol 2, 3rd Ed.

 

  Dim J, K, Temp

  Randomize

  For J = UBound(arData) To 1 Step -1

    K = Int((J + 1) * Rnd) ' random number 0 - J

    Temp = arData(J)

    arData(J) = arData(K)

    arData(K) = Temp

  Next

End Sub


Sub Recurse(oFldr,level)

    dim oFSO

    dim x

    dim sFile 'To keep the scope in here if need be

    set oFSO = CreateObject("Scripting.FileSystemObject")

    'wscript.echo "Folder:" & oFldr

            For Each oSubFolder In oFldr.SubFolders

                 Recurse oSubFolder,level+1

            Next

            if level>=2 then

                'wscript.echo "> " & oFldr

                arFirstName = CreateString(oFldr.name & "")

                'wscript.echo ubound(arFirstName)

                Shuffle arFirstName

                'Shuffle arLastName

                strUserName =  Join(arFirstName,"")' & " " & Join(arLastName,"")

                'wscript.echo oFldr.name & " == " & strUserName        

                'wscript.echo oFSO.GetParentFolderName( oFldr)

                wscript.echo "FROM: " & chr(34) & oFldr & chr(34)

                wscript.echo "  TO: " & chr(34) & oFSO.GetParentFolderName(oFldr) & "\" & trim(strUserName) & chr(34)

                oFSO.MoveFolder oFldr, oFSO.GetParentFolderName(oFldr) & "\" & trim(strUserName)

                REM wscript.sleep 2500

           end if  

      set oFSO = nothing          

    End Sub