Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Script for Moving jpg files from multiple directories into one

Status
Not open for further replies.

westie1871

Technical User
Aug 16, 2011
3
GB
Hi Folks,
i wonder if anyone could help me / point me in the right direction.

i am looking for a script that will allow me to run as a scheduled service that will scan multiple directories for *.jpg files and move them to one directory.

thanks in advance :)

 
1) find files in a directory
2) move the files

each operation is it's own function/sub. this makes it clean and easy to read.

Code:
'***********************************
'  FUNCTIONS AND SUBS
'***********************************

sub createDirectory (strDir)
	set objFSO = CreateObject("Scripting.FileSystemObject")
	if (right(strDir, 1) = "\") then strDir = left(strDir, len(strDir) - 1)
	strParentDir = objFSO.GetParentFolderName(strDir)
	if NOT (objFSO.FolderExists(strParentDir)) then createDirectory (strParentDir)
	if NOT (objFSO.FolderExists(strDir)) then objFSO.CreateFolder (strDir)
end sub

function searchFolder(strDir, strExt, boolSubFolders)
	set objFSO = CreateObject("Scripting.FileSystemObject")

	if (objFSO.FolderExists(strDir)) then
		set objFolder = objFSO.GetFolder(strDir)
		strExt = lcase(strExt)
	
		if (boolSubFolders) then
			for each objSubFolder in objFolder.SubFolder
				strResults = searchForOrder (objSubFolder.Path, strCriteria)
			next
		end if
	
		for each objFile in objFolder.Files
			if (right(objFile.Name, len(strExt)) = strExt) then strResults = strResults & objFile.Path & vbNewLine
		next
		searchFolder = split(strResults, vbNewLine)
	end if
end function

sub moveFiles(arrFiles, strDestination)
	set objFSO = CreateObject("Scripting.FileSystemObject")
		
	for each strFile in arrFiles
		if (strFile <> "") then
			set objFile = objFSO.GetFile(strFile)
			objFSO.MoveFile strFile, strDestination & "\" & objFile.Name
		end if
	next
end sub

'***********************************
'  BEGIN
'***********************************

dim arrPaths(2)

arrPaths(0) = "C:\temp\images"
arrPaths(1) = "C:\documents and settings\user\photos"
arrPaths(2) = "D:\development\pictures"

strExt = ".jpg"
strDestination = "D:\Images"

for each strPath in arrPaths
	arrFiles = searchFolder(strPath, strExt, false)
	createDirectory strDestination
	moveFiles arrFiles, strDestination
next

-Geates

"I hope I can chill and see the change - stop the bleed inside and feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer
 
Hi Buddy,
i get an error on this line stating object not a collection

for each strFile in arrFiles
 
Ah. you must be running Windows XP. Windows 7 interprets it as a collection.

Change the line to

Code:
for i = 0 to ubound(arrFiles) - 1
    strFile = arrFiles(i)

-Geates

"I hope I can chill and see the change - stop the bleed inside and feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer
 
I also just realized that there is an error that isn't an execution error so it be won't be caught and thrown.

strCriteria should be strExt

I assume that you've already done this.

-Geates

"I hope I can chill and see the change - stop the bleed inside and feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top