Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

Script to shorten file names and copy to different directory

Posted on 2011-02-24
8
Medium Priority
?
609 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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 1600 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 58

Assisted Solution

by:Bill Prew
Bill Prew earned 400 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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

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

Tech or Treat! - Giveaway

Submit an article about your scariest tech experience—and the solution—and you’ll be automatically entered to win one of 4 fantastic tech gadgets.

Question has a verified solution.

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

Hello again, all.  For those of you that have been following along, you'll know that this is my third article on this topic (though it is not Part III).  This article is sort of remedial, and probably the topic with which I should have started the s…
Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
In this video you will find out how to export Office 365 mailboxes using the built in eDiscovery tool. Bear in mind that although this method might be useful in some cases, using PST files as Office 365 backup is troublesome in a long run (more on t…
In this video, Percona Solution Engineer Rick Golba discuss how (and why) you implement high availability in a database environment. To discuss how Percona Consulting can help with your design and architecture needs for your database and infrastr…

610 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