Solved

Script to shorten file names and copy to different directory

Posted on 2011-02-24
8
602 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 52

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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Recently I finished a vbscript that I thought I'd share.  It uses a text file with a list of server names to loop through and get various status reports, then writes them all into an Excel file.  Originally it was put together for our Altiris server…
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 …
This Micro Tutorial will give you a basic overview how to record your screen with Microsoft Expression Encoder. This program is still free and open for the public to download. This will be demonstrated using Microsoft Expression Encoder 4.
Windows 10 is mostly good. However the one thing that annoys me is how many clicks you have to do to dial a VPN connection. You have to go to settings from the start menu, (2 clicks), Network and Internet (1 click), Click VPN (another click) then fi…

895 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

15 Experts available now in Live!

Get 1:1 Help Now