Solved

Script to shorten file names and copy to different directory

Posted on 2011-02-24
8
605 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
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.

 

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

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Well hello again!  Glad to see you've made it this far without giving up.  In this, the fourth installment of my popular series, I'm going to cover functions and subroutines, what they are, and why they are useful.  Just in case you stumbled onto th…
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…
In a recent question (https://www.experts-exchange.com/questions/29004105/Run-AutoHotkey-script-directly-from-Notepad.html) here at Experts Exchange, a member asked how to run an AutoHotkey script (.AHK) directly from Notepad++ (aka NPP). This video…
I've attached the XLSM Excel spreadsheet I used in the video and also text files containing the macros used below. https://filedb.experts-exchange.com/incoming/2017/03_w12/1151775/Permutations.txt https://filedb.experts-exchange.com/incoming/201…

829 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