Hi All
I have just finished (well finished enough for testing) a VBS tool I designed to my specific requirements and thought why not share it with everyone in case its useful to someone.
This is raw, I haven't live tested it on actual video files but it runs as expected on made up files.
Description:
A simple file renaming tool that will work on any 3 character extension files (mkv, avi, mp4, txt, etc). Renaming and moving them to a specific location and naming format.
How It Works:
I designed it to specifically rename NBA games that I watch in XBMC when I have the chance, these come in random naming formats and me being a bit of a neat freak spent time renaming to a specific way. What this tool does is extract the date from a file name, and the teams and then renames and moves the files to my XBMC folder for NBA games.
It works by splitting the files name according to periods "." and then examines each element between the "." for Year/Month/Date/Teams/Extension, it then rearranges them to my liking and moves them off to the correct folder, it also catches files it can't rename and moves them to a folder (that I will check regulary to manually fix), it also catches files that will end up duplicately named, and moves the original file to the same folder (as back up / for me to check).
It records everything it does into a txt log file, for debugging, fixing naming errors etc.
Examples:
NBA.RS.05.11.2013.Thunder@Suns.RandomStuff.720p.hello.mkv will become: NBA - 2013.11.05 - Thunder@Suns.mkv (and be moved to my NBA XBMC folder)
2013.05.11.NBA.720p.Thunder@Suns.RandomStuff.avi will become will become: NBA - 2013.11.05 - Thunder@Suns.avi
Etc
Conditions on it working:
Elements must be separated by periods "." (I will work on expanding this later)
It must have a Year a Month and a Date in numbers, the month and year also work of the current month and year (it was built for sports) (again I will work on expanding this so its more dynamic)
It must have teams separated by "@" symbol (again I will be working to expand)
Its very Alpha and limited at the moment, but I hope to expand it quite a bit to cover off more situations.
I personally plan to use this automatically as a scheduled task.
How To Use:
Open a new blank txt file. Then copy all of this code below into the txt file:
Code:
On Error Resume Next
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = ObjFSO.GetFolder("C:\Users\tbaker\Documents\NBA\") 'CHANGE THIS PATH TO THE PATH WHERE YOUR FILES WILL ORIGINALLY BE LOCATED AKA SOURCE FOLDER
desFolder = "C:\Users\tbaker\Documents\WIP\" 'CHANGE THIS PATH TO THE PATH WHERE YOU WOULD LIKE THE RENAMED FILES TO GO
outFile = "C:\Users\tbaker\Documents\WIP\NBA Namer Log.txt" 'CHANGE THIS PATH TO THE PATH TO YOUR LOGGING TEXT FILE (YOU NEED TO CREATE THIS)
invalidFolder = "C:\Users\tbaker\Documents\WIP\Invalid\" 'NEED TO CHANGE THIS PATH TO WHERE YOU WOULD LIKE THE INVALID FILES TO GO IF RENAMING IS UNSUCESSFUL
If Err.Number <> 0 Then
Set objFile = objFSO.OpenTextFile(outFile,8,True,0)
objFile.WriteLine Date & " " & Time & " - ERROR - " & Err.Number & " - " & Err.Description & " - In Line 9 to 13, In assigning desfolder / source folder - END" & vbCrLf
objFile.Close
WScript.Quit
End If
If objFolder.Files.Count = 0 Then
Set objFile = objFSO.OpenTextFile(outFile,8,True,0)
objFile.WriteLine Date & " " & Time & " - No Files To Process - END" & vbCrLf
objFile.Close
WScript.Quit
End If
Set colFiles = objFolder.Files
For Each objFile In colFiles
filename = objFile.Name
fileExt = Right(filename,3)
FileNameArr = Split(filename,".")
If Err.Number <> 0 Then
Set objFile = objFSO.OpenTextFile(outFile,8,True,0)
objFile.WriteLine Date & " " & Time & " - ERROR - " & Err.Number & " - " & Err.Description & " - On File: " & filename & " - In Line 23 to 26, In assigning filename/fileExt and splitting filename - END" & vbCrLf
objFile.Close
WScript.Quit
End If
Dim curYear
Dim curMonth
curYear = Year(Date)
curMonth = Month(Date)
For i = LBound(FileNameArr) To UBound(FileNameArr)
If IsNumeric(FileNameArr(i)) Then
If CInt(FileNameArr(i)) = curYear Then
strYear = FileNameArr(i)
Else
If CInt(FileNameArr(i)) = curMonth Then
strMonth = FileNameArr(i)
Else
If CInt(FileNameArr(i)) = curMonth - 1 Then
strMonth = FileNameArr(i)
Else
If Len(FileNameArr(i)) = 2 Then
strDate = FileNameArr(i)
Else
End If
End If
End If
End If
Else
If InStr(1,FileNameArr(i),"@") > 0 Then
strTeams = FileNameArr(i)
Else
End If
End If
If Err.Number <> 0 Then
Set objFile = objFSO.OpenTextFile(outFile,8,True,0)
objFile.WriteLine Date & " " & Time & " - ERROR - " & Err.Number & " - " & Err.Description & " - On File: " & filename & " - In Lines 40 to 68, defining Year/Month/Date/Teams" & " - END" & vbCrLf
objFile.Close
WScript.Quit
End If
Next
NoVar = 0
If strYear = "" Then
NoVar = NoVar + 1
Else
End If
If strMonth = "" Then
NoVar = NoVar + 1
Else
End If
If strDate = "" Then
NoVar = NoVar + 1
Else
End If
If strTeams = "" Then
NoVar = NoVar + 1
Else
End If
If NoVar > 0 Then
objFSO.MoveFile objFile, invalidFolder & objFile.Name
Set objFile = objFSO.OpenTextFile(outFile,8,True,0)
objFile.WriteLine Date & " " & Time & " - INVALID NAME - Original FileName: " & filename & " - Missing variables (either Year, Month, Date or Teams) - File Moved To Invalid Name Folder - END" & vbCrLf
objFile.Close
Else
NewFileName = "NBA - " & strYear & "." & strMonth & "." & strDate & " - " & strTeams & "." & fileExt 'NEED TO RENAME THE THINGS IN "" TO WHAT YOU WANT THEM TO BE, YOU CAN ALSO REORDER NAME ITEMS AS LONG AS fileExt IS LAST
Exists = 0
objFSO.MoveFile objFile, desFolder & NewFileName
If Err.Number <> 0 Then
If Err.Number = 58 Then
objFSO.MoveFile objFile, invalidFolder & objFile.Name
Set objFile = objFSO.OpenTextFile(outFile,8,True,0)
objFile.WriteLine Date & " " & Time & " - INVALID ACTION - " & Err.Number & " - " & Err.Description & " - On File: " & filename & " - File already exists, moved to Invalid folder - END" & vbCrLf
objFile.Close
Exists = 1
Else
Set objFile = objFSO.OpenTextFile(outFile,8,True,0)
objFile.WriteLine Date & " " & Time & " - ERROR - " & Err.Number & " - " & Err.Description & " - On File: " & filename & " - Line 105, Moving / Renaming file - END" & vbCrLf
objFile.Close
WScript.Quit
End If
End If
If Exists = 0 Then
Set objFile = objFSO.OpenTextFile(outFile,8,True,0)
objFile.WriteLine Date & " " & Time & " - File Renamed - Original FileName: " & filename & " - Renamed To: " & NewFileName & " - Moved To NBA Folder - END" & vbCrLf
objFile.Close
Else
End If
filename = ""
fileExt = ""
strYear = ""
strMonth = ""
strDate = ""
strTeams = ""
NewFileName = ""
End If
Next
Find this part (near the top)
Code:
Set objFolder = ObjFSO.GetFolder("C:\Users\tbaker\Documents\NBA\") 'CHANGE THIS PATH TO THE PATH WHERE YOUR FILES WILL ORIGINALLY BE LOCATED AKA SOURCE FOLDER
desFolder = "C:\Users\tbaker\Documents\WIP\" 'CHANGE THIS PATH TO THE PATH WHERE YOU WOULD LIKE THE RENAMED FILES TO GO
outFile = "C:\Users\tbaker\Documents\WIP\NBA Namer Log.txt" 'CHANGE THIS PATH TO THE PATH TO YOUR LOGGING TEXT FILE (YOU NEED TO CREATE THIS)
invalidFolder = "C:\Users\tbaker\Documents\WIP\Invalid\" 'NEED TO CHANGE THIS PATH TO WHERE YOU WOULD LIKE THE INVALID FILES TO GO IF RENAMING IS UNSUCESSFUL
You need to replace all the files paths to ones that you actually use/have created 
they can go where ever you want, but I suggest making the desFolder the folder XBMC will see.
Save the text file. In windows right click the text file and rename it giving it a ".vbs" file extension.
Its done and it should be ready to roll.
If you want to mess with the naming format (for example to remove "NBA") the code is located near the bottom and I have notes next to in in CAPTIALS.
Let me know if you have any issues with it, for now I recommend making sure there is only the files you want to rename in the source folder.
Its quite simple at the moment, I'm hoping to develop it a bit more, but I might not as it should suit my needs perfectly as is haha and I might not have the time.
Any improvements are welcome
Cheers