×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Really need to modify This VBS !

Really need to modify This VBS !

Really need to modify This VBS !

(OP)
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 :

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 !

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close