Solved

Script to shorten file names and copy to different directory

Posted on 2011-03-01
5
851 Views
Last Modified: 2012-05-11
I have a script that sungenwang was kind enough to help me with but I need one change to it. I need it to perform the copying all of the files in the subdirectories to the new location without creating the directory file structure at the new location.

Set objFSO = CreateObject("Scripting.FileSystemObject")

Call MoveFolder("c:\temp", "c:\temp2")


Sub MoveFolder(strSourceFolder, strTargetFolder)
	Set objCurrentFolder = objFSO.GetFolder(strSourceFolder)

	For Each objFile In objCurrentFolder.Files
		strTargetPath = strTargetFolder & "\" & ChangeFileName(objFSO.GetFileName(objFile))
		'msgbox "file" & vbCrLf & objFile & vbCrLf & strTargetPath

		objFSO.CopyFile objFile, strTargetPath
	Next

	For Each objFolder In objCurrentFolder.subFolders
		strTargetNewFolder = strTargetFolder & Replace(objFolder, objFSO.GetParentFolderName(objFolder), "")
		'msgbox "folder" & vbCrLf & objFolder & vbCrLf & strTargetNewFolder
		
		If Not objFSO.FolderExists(strTargetNewFolder) Then
			objFSO.CreateFolder(strTargetNewFolder)
		End If

		Call MoveFolder(objFolder, strTargetNewFolder)
	Next
End Sub


Function ChangeFileName(strFileName)
	intPos = InStr(strFileName, "_")
	
	If intPos > 0 Then
		ChangeFileName = Left(strFileName, InStr(strFileName, "_")-1) & "." & objFSO.GetExtensionName(strFileName)
	Else
		ChangeFileName = strFileName
	End If
	'msgbox ChangeFileName
End Function

Open in new window

0
Comment
Question by:swhitti
  • 2
  • 2
5 Comments
 
LVL 12

Accepted Solution

by:
prashanthd earned 200 total points
ID: 35010675
Hi,

Please try the below modified code.

Set objFSO = CreateObject("Scripting.FileSystemObject")

Call MoveFolder("c:\temp", "c:\temp2")


Sub MoveFolder(strSourceFolder, strTargetFolder)
	Set objCurrentFolder = objFSO.GetFolder(strSourceFolder)

	For Each objFile In objCurrentFolder.Files
		strTargetPath = strTargetFolder & "\" & ChangeFileName(objFSO.GetFileName(objFile))
		'msgbox "file" & vbCrLf & objFile & vbCrLf & strTargetPath

		objFSO.CopyFile objFile, strTargetPath
	Next

	For Each objFolder In objCurrentFolder.subFolders
		'strTargetNewFolder = strTargetFolder & Replace(objFolder, objFSO.GetParentFolderName(objFolder), "")
		'msgbox "folder" & vbCrLf & objFolder & vbCrLf & strTargetNewFolder
		
		'If Not objFSO.FolderExists(strTargetNewFolder) Then
			'objFSO.CreateFolder(strTargetNewFolder)
		'End If

		Call MoveFolder(objFolder, strTargetFolder)
	Next
End Sub


Function ChangeFileName(strFileName)
	intPos = InStr(strFileName, "_")
	
	If intPos > 0 Then
		ChangeFileName = Left(strFileName, InStr(strFileName, "_")-1) & "." & objFSO.GetExtensionName(strFileName)
	Else
		ChangeFileName = strFileName
	End If
	'msgbox ChangeFileName
End Function

Open in new window

0
 
LVL 45

Expert Comment

by:aikimark
ID: 35011814
How do you intend to deal with duplicate filenames causing overwriting?
0
 

Author Comment

by:swhitti
ID: 35012047
Thanks prashanthd!

@aikimark, thanks for the question. In my case I don't mind duplicate filenames causing overwriting as we want the files to update anytime they change in the original folder.
0
 
LVL 45

Assisted Solution

by:aikimark
aikimark earned 100 total points
ID: 35012457
>>...anytime they change in the original folder
This code doesn't look at the change flag or compare modified date values.  Is this doing what you need?

I usually recommend using a Windows API that will hook a program into the file system to get notices of directory/file changes via callback.

===========
The only thing I can suggest to improve performance of the prashanthd code is to:
1. remove the commented code
2. replace the ChangeFileName() function with the following:

Function ChangeFileName(strFileName)
	intPos = InStr(strFileName, "_")
	
	If intPos > 0 Then
		ChangeFileName = Left(strFileName, intPos -1) & "." & objFSO.GetExtensionName(strFileName)
	Else
		ChangeFileName = strFileName
	End If
End Function

Open in new window

0
 

Author Comment

by:swhitti
ID: 35013298
Thanks aikimark. At this point I think this script is going to do what I need it to. I don't think there will be a lot of changes to the existing files just additional ones. Thanks for the recommendations, I incorporated them into the final script I plan on using.
0

Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Script to copy or move mouse-selected collection of files plus targets referenced by shortcuts (.lnk) The purpose of this article is to help illuminate the real challenges and options available (where they may exist) for utilizing simple scriptin…
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
Nobody understands Phishing better than an anti-spam company. That’s why we are providing Phishing Awareness Training to our customers. According to a report by Verizon, only 3% of targeted users report malicious emails to management. With compan…

856 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question