Solved

Script to shorten file names and copy to different directory

Posted on 2011-02-24
8
599 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 51

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
 

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
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 
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

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

Suggested Solutions

This is pretty cool.  The purpose of this VB Script is to help you document where JAR (Java ARchive) files and specifically java class files are located so that you can address issues seen with a client or that you can speak intelligently with a dev…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.

758 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

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now