Rename file using Dat ein file name and custom auto number duplicates

akpuggy · November 19, 2016, 6:01am

YES!! I finally found a way to replace my old file renaming tool. The reason why I could not use the DOpus rename function is because of how standard rename dialog handles duplicate names 1) It does not allow you to preview changes 2) It uses an auto number with parentheses rather than allowing a custom format. But now I finally was able to write a script!

My script adds all the previous new names to a string and then regex checks the string before generating a name for the second file. Based on the number of times it encounters that name already in the string, it adds that number to the ending of the file name. Although it seems to work extremely well, I see two scenarios where this may be a problem and just wanted to share the script and get feedback if there is an obvious way to get around one or both of those minor issues.

You cannot have an infinite number of characters in a string variable. So possibly if I try to rename over 1k files, the sting will go blank (I experienced this in another piece of Metatags code).
If you do not select all files in the folder and one of the files not selected may have a duplicate name, you will get an error to a duplicate file exists.

[code]Option Explicit

Dim newNameString
newNameString = Empty

Function OnGetNewName (ByRef GetNewNameData)

Dim item, itemName, newName, meta, fileName, createdDate, re0, re1, re1Match, re1Count
Set item = GetNewNameData.item
Set meta = item.metadata
itemName = item.name_stem
newName = Empty

Set re0 = new RegExp
re0.Pattern = ".*(20[0-2][0-9])\D?([0-1][0-9])\D?([0-3][0-9])\D?([0-2][0-9])\D?([0-5][0-9])\D?([0-5][0-9]).*"
re0.IgnoreCase = True

If (re0.Test(itemName)) Then
	newName = re0.Replace(itemName, "$1-$2-$3_$4-$5-$6")				
Else
	newName = itemName
End If

Set re1 = new regExp
re1.Pattern = newName
re1.IgnoreCase = True
re1.Global = True

Set re1Match = re1.Execute(newNameString)
re1Count = re1Match.count
DOpus.Output re1Count

If (re1.Test(newNameString)) Then
	If re1Count < 10 Then
		newName = newName & "_0" &	re1Count
	Else
		newName = newName & "_" &	re1Count
	End If	
End If

If newNameString = Empty Then
	newNameString = newName
Else
	newNameString = newNameString & "," & newName
End If

If (newName <> Empty) Then
	'OnGetNewName = newName & item.ext
	OnGetNewName = newName & LCase(item.ext) 
Else
    OnGetNewName = True
End If

End Function
'http://www.robvanderwoude.com/vbstech_regexp.php[/code]

Leo · November 19, 2016, 6:45am

Add a Unique Number while renaming shows another way to do it, where the script checks if a file with the generated name already exists, instead of keeping track of all previously used names itself. (The fileystem does that for you, after all. Also means it lets you rename some files in places which already have other files whose names aren't changing but may conflict.)

akpuggy · November 19, 2016, 8:08pm

Thanks leo. I did see that unique numbering script before but could not find a way to customize it to my expected output. Even if I did not care much for a correct preview of new file names before actually renaming, I still only want to add a unique number only to names that have already been set. So if I have three files a.jpg, b.jpg, b.jpg (two of which are duplicate) I would like their name to be: a.jpg, b_01.jpg, b_02.jpg. Not a_01.jpg, b_01.jpg, b_02.jpg

I thought this was interesting "fs.FileExists" though. Is there a way to incorporate that into my script somehow so that I do not have to keep track of existing files? Or what would the most basic use of that code be like without any parameters or special conditions?

i.e.

[code]Option Explicit

Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")

Function OnGetNewName (ByRef GetNewNameData)

Dim item, itemName, num, bNeedLoop
Set item = GetNewNameData.item
itemName = "test"
itemPath = fs.GetAbsolutePathName(itemName)
num = 0

bNeedLoop = True
While bNeedLoop
	If fs.FileExists(itemPath) Then
		num = num + 1
		itemName = itemName & "_0" & num
	Else
		bNeedLoop = False
Wend

If (itemName <> Empty) Then
	OnGetNewName = itemName & item.ext
Else
	OnGetNewName = True
End If

End Function[/code]

akpuggy · November 21, 2016, 2:37am

leo, I played enough with your example to finally get it to work with my script and without me having to store each name in a string. Super happy with the results, but I noticed that the entire queue of files in the rename list does not get processed until you scroll down to the bottom of them. This causes the function to reset each time you scroll and some counters to reset. Is that just an issue with how preview works, or is there something in my script that I can do to change that behavior? See here: goo.gl/C01AnP

Here is my perfectly working script (I think)

[code]Option Explicit
DOpus.Output "Number;File Name;File Name New;File Name Date;Modified Date;Date Taken;Date Digitized;File Type;Change Type"

Dim fs, countFiles
Set fs = CreateObject("Scripting.FileSystemObject")
countFiles = 0

Function OnGetNewName (ByRef GetNewNameData)
countFiles = countFiles + 1
Dim file, fileType, fileName, itemName, fileExt, fileFolder, fileNameDate, imgTaken, imgDigitized, modifiedDate, countSearchTags, fileNameTest, filePathTest, fileNameNew, re0, re1, tag, changeType, num, bNeedLoop
Set file = GetNewNameData.item
Set fileType = file.metadata
fileName = file.name_stem
fileExt = LCase(file.ext)
fileFolder = fs.GetParentFolderName(file)
fileNameDate = Empty
imgTaken = Empty
imgDigitized = Empty
modifiedDate = file.modify.Format("D#yyyy-MM-dd_T#HH-mm-ss")
countSearchTags = 0
fileNameTest = Empty
filePathTest = Empty
fileNameNew = Empty

'Check if file was tagged
Set re0 = new RegExp
re0.Pattern = "^(Name()(.)(),\s)(Created()(\d)(),\s)(Modified()(\d*).(),\s)(Tagged()(\d))"
re0.IgnoreCase = True
If (fileType <> "none") Then
For Each tag In fileType.tags
If (re0.Test(tag)) Then
countSearchTags = countSearchTags + 1
End If
Next
End If

'Check if file contains Date in the Name
Set re1 = new RegExp
re1.Pattern = ".(20[0-2][0-9])\D?([0-1][0-9])\D?([0-3][0-9])\D?([0-2][0-9])\D?([0-5][0-9])\D?([0-5][0-9])."
re1.IgnoreCase = True
If (re1.Test(fileName)) Then
fileNameDate = re1.Replace(fileName, "$1-$2-$3_$4-$5-$6")
End If

'Check if File contains is Image and contains Date Taken
If (fileType = "image") Then
imgTaken = fileType.image.datetaken
If (imgTaken <> Empty) Then
imgTaken = fileType.image.datetaken.Format("D#yyyy-MM-dd_T#HH-mm-ss")
End If
imgDigitized = fileType.image.datedigitized
If (imgDigitized <> Empty) Then
imgDigitized = fileType.image.datedigitized.Format("D#yyyy-MM-dd_T#HH-mm-ss")
End If
End If

'1st - Test for Date Taken, 2nd - Test for Date in File Name, 3rd - Use modified Date if first two fail.
If (imgTaken <> Empty) Then
fileNameNew = imgTaken
changeType = "Used Image Taken Date"
Elseif (fileNameDate <> Empty) Then
fileNameNew = fileNameDate
changeType = "Used Filename Date"
Else
fileNameNew = modifiedDate
changeType = "Used Modify Date"
End If

'Test if New File Name already exists in same folder
If fileNameNew <> fileName Then
num = 0
bNeedLoop = True
fileNameTest = fileNameNew
While bNeedLoop
filePathTest = fs.BuildPath (fileFolder, fileNameTest & fileExt)
If fs.FileExists(filePathTest) Then
num = num + 1

			If num < 10 Then
				fileNameTest = fileNameNew & "_0" & num 
			Else
				fileNameTest = fileNameNew & "_" & num	
			End If
		Else
			fileNameNew = fileNameTest
			bNeedLoop = False
		End if
	Wend
End If

'Rename if File was tagged and new Name has changed from original
If countSearchTags > 0 Then
If (fileNameNew <> Empty) Then
OnGetNewName = fileNameNew & fileExt
DOpus.Output countFiles & ";" & fileName & fileExt & ";" & fileNameNew & fileExt & ";" & fileNameDate & ";" & modifiedDate & ";" & imgTaken & ";" & imgDigitized & ";" & fileType & ";" & changeType
Else
OnGetNewName = True
End If
Else
changeType = "No Tags - Review"
DOpus.Output countFiles & ";" & fileName & fileExt & ";" & fileNameNew & fileExt & ";" & fileNameDate & ";" & modifiedDate & ";" & imgTaken & ";" & imgDigitized & ";" & fileType & ";" & changeType
End If

End Function[/code]

Leo · November 21, 2016, 2:41am

The preview list usually only runs the script for the visible items, since there isn't usually much point running it for items you can't see.

To actually apply the script to all files, and rename things based on what it returns, you need to click OK or Apply.