Solved

Script to shorten file names and copy to different directory

Posted on 2011-02-24
8
603 Views
Last Modified: 2012-05-11
I am a newbie in scripting and need some assistance taking some files in a directory, and its subdirectories, shortening the names and then copying them to another folder, leaving the originals in place. To add to this I also only need the files that have a .jpg extension to be included in the script (this is a nice to have but not absolutely necessary).

These file names all begin with numbers and then an underscore and then an employee's name, ie. 1234_Scott_Smith, 345_John_Smith. What I need is the file names to be changed to include only up to the underscore. In doing some research I have only been able to get to changing the files to the first specific amount of digits but that isn't going to help me since since the files are not all consistent.

Thanks for any help in pointing me in the right direction.
0
Comment
Question by:swhitti
  • 4
  • 3
8 Comments
 

Author Comment

by:swhitti
ID: 34972849
I found a script that basically does almost everything I need from this question:

http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_23390223.html?sfQueryTermInfo=1+10+30+directori+file.txt+ie+newdirectori+suba

The script that I tested is the following:

'i.e. Directory/SubA/File.txt = NewDirectory/SubA_File.txt
'Directory/SubB/File.xml = NewDirectory/SubB_File.xml  
 
SpecialMove "C:\Script Test", "C:\ToSFTP"
 
Function SpecialMove(SourcePath, DestinationPath) 'As Boolean
	Dim Dst_Folder 'As Folder
	Dim Src_Folder 'As Folder
	Dim SubFolder 'As Folder
	
	Dim File 'As File
	
	Dim fso 'As Scripting.FileSystemObject
	Set fso = CreateObject("Scripting.FileSystemObject")
	
	'** Validate Paths
		If Not fso.FolderExists(SourcePath) Then
			SpecialMove = False
			Exit Function
		End If
		If Not fso.FolderExists(DestinationPath) Then
			SpecialMove = False
			Exit Function
		End If
	
	'** Load Folder Objects
		Set Src_Folder = fso.GetFolder(SourcePath)
		Set Dst_Folder = fso.GetFolder(DestinationPath)
	
	'** Copy Root Files
		For Each File In Src_Folder.Files
			Debug.WriteLine "Copy = " & File.Path & " TO " & Dst_Folder.Path
			File.Copy Dst_Folder.Path & "\"
		Next
	
	'** Copy subfolder files to "<Root>\Subfolder_file.ext"
		For Each SubFolder In Src_Folder.SubFolders
			For Each File In SubFolder.Files
				Debug.WriteLine "Copy = " & File.Path & " TO " & Dst_Folder.Path & "\" & SubFolder.Name & "_" & File.Name
				File.Copy(Dst_Folder.Path & "\" & SubFolder.Name & "_" & File.Name)
			Next
		Next
End Function

Open in new window


The only piece it doesn't accomplish for me is renaming the files to all the digits before the "_" in the current file names.
0
 
LVL 14

Accepted Solution

by:
sungenwang earned 400 total points
ID: 34974864
I believe the code below will do what you need, removing all the characters after the underscore (_).
Just change the source and target folder name and run it.

sew

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, "_")) & "." & objFSO.GetExtensionName(strFileName)
	Else
		ChangeFileName = strFileName
	End If
	'msgbox ChangeFileName
End Function

Open in new window

0
 
LVL 53

Assisted Solution

by:Bill Prew
Bill Prew earned 100 total points
ID: 34976091
I respect that you asked for a VB script, but since this would be pretty simple in a BAT script I wanted to share an example of that.  Just save as a BAT file, adjust the from and to folders and give it a try.

@echo off
set BaseDir=c:\temp
set DestDir=d:\new
for /R "%BaseDir%" %%A in (*.jpg) do (
  for /F "tokens=1 delims=_" %%B in ("%%~nA") do (
    copy "%%A" "%DestDir%\%%B.jpg"
  )
)

Open in new window

~bp
0
Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

 

Author Closing Comment

by:swhitti
ID: 34981078
Thank you both for working on this for me. I REALLY appreciate it. I have given you both points for your answers. I do have one additional question that I hope you can help with. I know I mentioned that the new file names would be up to the '_' but would it be possible to remove the '_' also?
0
 
LVL 14

Expert Comment

by:sungenwang
ID: 34981136
Sure... I thought you wanted the "_".

I just changed this line from:
            ChangeFileName = Left(strFileName, InStr(strFileName, "_")) & "." & objFSO.GetExtensionName(strFileName)


To:
            ChangeFileName = Left(strFileName, InStr(strFileName, "_")-1) & "." & objFSO.GetExtensionName(strFileName)

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
 

Author Comment

by:swhitti
ID: 34981460
Thanks so much for your help! You have save me so much time and I've learned a few things on the way. Thanks again.
0
 
LVL 14

Expert Comment

by:sungenwang
ID: 34981484
you're welcome and happy coding...
0
 

Author Comment

by:swhitti
ID: 35009605
Hi Sunqenwang. I hate to do this but I have now been asked to move all the files to one location without creating the folder structure. Could you possibly modify the script to accomplish this?
0

Featured Post

Live: Real-Time Solutions, Start Here

Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

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…
I met Paul Devereux (@pdevereux) today when I responded to his tweet asking “Anybody know how to automate adding files from disk to a folder in #outlook  ?”.  I replied back and told Paul that using automation, in this case scripting, to add files t…
This Micro Tutorial will teach you how to censor certain areas of your screen. The example in this video will show a little boy's face being blurred. This will be demonstrated using Adobe Premiere Pro CS6.
Microsoft Active Directory, the widely used IT infrastructure, is known for its high risk of credential theft. The best way to test your Active Directory’s vulnerabilities to pass-the-ticket, pass-the-hash, privilege escalation, and malware attacks …

785 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