asked on

Checking and Moving Folders Using VBScript

I am writing some VBScript to cycle through directories on a server and move any files or folders which have a specified piece of text on the end to a directory on the C:\

I have successfully created the script to cycle through and move the files but am struggling with the folders, my code is below:

'Create an output file to store original directory of file/folder
createFileName = "C:\Copied_Files_Dir\Record_Of_Moved_Files.txt"
set fileScrObj = CreateObject("Scripting.FileSystemObject")
set createFile = fileScrObj.CreateTextFile(createFileName)

'Gather end part of name via an input box
DisplayText1 = "Enter either the extension type or the full file name you want to clear."
extType = InputBox(DisplayText1)
wscript.echo "You have chosen to move files ending in " & extType & ". A record of all moved files will be created here: " &

vbCr & vbCr & "C:\CopiedFilesRecord"

inputLength = len(extType)
destDir = "C:\Copied_Files_Dir"

CurrentDir = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
'wscript.echo CurrentDir
strFolder = "C:\Documents and Settings\T104ahe\Desktop\Menu\VBScripts"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strFolder)
'WScript.Echo extType

Set colFiles = objFolder.Files

For Each objFile In colFiles
       If (Right (objFile.Path, inputLength) = extType) Then
            createFile.WriteLine(objFile.path)
            objFile.Move destDir & "\"
       End If
Next

ShowSubFolders(objFolder)

Sub ShowSubFolders(objFolder)
Set colFolders = objFolder.SubFolders
For Each objSubFolder In colFolders
'WScript.Echo objSubFolder.Path
Set colFiles = objSubFolder.Files
For Each objFile In colFiles
       If (Right (objFile.Path, inputLength) = extType) Then
            createFile.WriteLine(objFile.path)
            objFile.Move destDir & "\"
       End If
Next
ShowSubFolders(objSubFolder)
Next
End Sub

RobSampson

Hi, what you need to is treat files and folders separately in the ShowSubFolders procedure, instead of looping the files inside the looping of the subfolders.

Use a For loop for the files of objFolder, then use another For loop *after* that to iterate through the subfolder names, calling ShowSubFolders again.

In doing this, you don't the colFiles For loop that you have outside of the ShowSubFolders procedure in the main code.

Regards,

Rob.

'Create an output file to store original directory of file/folder
createFileName = "C:\Copied_Files_Dir\Record_Of_Moved_Files.txt"
set fileScrObj = CreateObject("Scripting.FileSystemObject")
set createFile = fileScrObj.CreateTextFile(createFileName)

'Gather end part of name via an input box
DisplayText1 = "Enter either the extension type or the full file name you want to clear."
extType = InputBox(DisplayText1)
wscript.echo "You have chosen to move files ending in " & extType & ". A record of all moved files will be created here: " & 

vbCr & vbCr & "C:\CopiedFilesRecord"

inputLength = len(extType)
destDir = "C:\Copied_Files_Dir"

CurrentDir = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
'wscript.echo CurrentDir
strFolder = "C:\Documents and Settings\T104ahe\Desktop\Menu\VBScripts"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strFolder)
'WScript.Echo extType

ShowSubFolders(objFolder)

Sub ShowSubFolders(objFolder)
	For Each objFile In objFolder.Files
		If (Right (objFile.Path, inputLength) = extType) Then
			createFile.WriteLine(objFile.path)
			objFile.Move destDir & "\"
		End If
	Next
	For Each objSubFolder In objFolder.SubFolders
		'WScript.Echo objSubFolder.Path
		ShowSubFolders(objSubFolder)
	Next
End Sub

Open in new window

Lico_w

ASKER

Hi Rob, I'm slightly confused.

Could I do the subfolders bit in a seperate script? If so how would I do that.

ASKER CERTIFIED SOLUTION

RobSampson

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Lico_w

ASKER

Thanks Rob, I had another look at this today and got it working, u da man!

RobSampson

No problem. Thanks for the grade.

Rob.