Really need to modify This VBS !

[Yaxtrea]

Hi everyone!

(excuse my english)

I need to modify a VBS that I took from an other forum, it's used to move UP level all files within a folder structure

- better explained with examples:

let's say I Have this folder Structure

Level 1 > Level 2 > Level 3 > Level 4 > Level 5 > files.mp3

Level 1 > Level 2 > Level 3 > Level 4 > Level 5 > files.mp3
Level 1 > Level 2 > Level 3 > Level 4 > files.mp3
Level 1 > Level 2 > Level 3 > Level 4 > Level 5 > files.mp3

The script as it is would move the files.mp3 to the LVL 3 Folder and remove the empty ones ( lvl 4 & 5 )

WHAT i NEED IT TO DO (in my case):

is to move them to lvl 4 for this specific urgent case I'm in !

but if you can make it customizable (make the user have control over the lvl in which he likes to put the files ) I would be thankful (I'll be thankful in all cases)

on the script you will find

3 variables a final user (me) has control over :

is the base Folder from which the script starts lookin down the structure

and the file types you want to move

and a debug (on or off) that gives you a log file if its "on" or executes the script if its "off" .

Here's the Script Code :

Option Explicit
Dim base,ext,debug,dest,oShell,fso,olog
Dim i,oExec,oOut,fldrs,j,fls,k,ret,f2del
' ****************************
' AMEND AS NECESSARY
base="C:\base folder\"		'<- CHANGE THIS TO THE BASE FOLDER
ext=".ext"			'<- CHANGE THIS TO THE REQUIRED EXTENSION
' CHANGE THE DEBUG VALUE TO 0 TO PERFORM THE ACTIONS
' When debug=1, a log file (MoveUp.log) will be created.
' Verify that everything appears OK, then change this value
' to 0, and run the script to actually move the files and
' delete the remaining folders.
debug=0				'<- CHANGE THIS TO 0 IF ALL APPEARS OK
' ****************************
If Right(base,1)="\" Then
	base=Left(base,Len(base) -1)
End If
If Left(ext,1)<>"." Then
	ext="." & ext
End If
dest=Split(getDestFldrs(base),vbCrLf)
Set oShell=CreateObject("WScript.Shell")
Set fso=CreateObject("Scripting.FileSystemObject")
Set olog=fso.CreateTextFile(Left(WScript.ScriptFullName, _
					Len(WScript.ScriptFullName) -3) & "Log", True)
If debug then
	olog.WriteLine("Destination Folders:")
	For i=0 To UBound(dest) -1
		olog.WriteLine(dest(i))
	Next
	olog.WriteLine()
End If
For i=0 To UBound(dest) -1
	Set oExec=oShell.Exec("Cmd /C Dir /S /B /AD " & Chr(34) & dest(i) & Chr(34))
	Set oOut=oExec.StdOut
	fldrs=Split(oOut.ReadAll,vbCrLf)
	If UBound(fldrs)>0 Then
		If debug Then
			olog.WriteLine("The following files will be moved to:")
			olog.WriteLine(dest(i)&vbCrLf)
		End If
	End If
	For j=0 To UBound(fldrs) -1
		If debug Then
			Set oExec=oShell.Exec("Cmd /C Dir /B " & Chr(34) & fldrs(j) & "\*" & ext & Chr(34))
			Set oOut=oExec.StdOut
			fls=Split(oOut.ReadAll,vbCrLf)
			For k=0 To UBound(fls) -1
				olog.WriteLine(fldrs(j) & "\" & fls(k))
			Next
		Else
			ret=oShell.Run("Cmd /C Move /Y " & Chr(34) & fldrs(j) & "\*" & ext & Chr(34) & " " & Chr(34) & dest(i) & "\" & Chr(34),0,True)
			If ret then
				WScript.Echo "ERROR! MOVING FILES"
			End If
		End If
	Next
	Set oExec=oShell.Exec("Cmd /C Dir /B /AD " & Chr(34) & dest(i) & Chr(34))
	Set oOut=oExec.StdOut
	f2del=Split(oOut.ReadAll, vbCrLf)
	If debug Then
		If UBound(f2del)>0 Then
			olog.WriteLine(vbCrLf & "The following directories (and subdirectories), below the folder:" & vbCrLf & dest(i) & vbCrLf & "will be removed:")
		End If
	End If
	For j=0 To UBound(f2del) -1
		If debug Then
			olog.WriteLine(f2del(j))
		Else
			ret=oshell.Run("Cmd /C RD /Q /S " & Chr(34) & dest(i) & "\" & f2del(j) & Chr(34),0,True)
			If ret Then
				Wscript.Echo "ERROR! REMOVING FOLDER"
			End If
		End If
	Next
	olog.WriteLine()
Next
WScript.echo "Done!"
' ***** END OF SCRIPT *****
Function getDestFldrs(sPath)
	Dim fso, fldr, sFldr, dest
	dest=""
	Set fso=WScript.CreateObject("Scripting.FileSystemObject")
	With fso.GetFolder(sPath)
		If .SubFolders.Count>0 Then
			For Each fldr In .SubFolders
				With fso.GetFolder(fso.BuildPath(sPath, fldr.Name))
					If .SubFolders.Count>0 Then
						For Each sFldr In .SubFolders
							dest=dest & fso.BuildPath(fso.BuildPath(sPath,fldr.Name),sfldr.Name) & vbCrLf
						Next
					End If
				End With
			Next
		End If
	End With
	getDestFldrs=dest
End Function

Thank You !