FILENAME: ISRCAssignSeq.vbs
----------------------------------------------------------------------------------------------------------------------------------------
Code: Select all
Sub ISRCAssignSeq
Dim startISRC, startFilename, currentISRC, currentFilename, prefix, num, finalISRC
'If answer=7 then
' Exit Sub
'End If
' Ask user for a starting ISRC
startISRC=InputBox("First ISRC in series:" & vbCrLf & vbCrLf & vbCrLf & vbCrLf & _
"(Example: US-R4L-08-00001)", "ISRC Assign Sequential", "US-")
' Cancel if they hit cancel
If startISRC="" then
Exit Sub
End If
currentISRC = UCase(startISRC)
prefix = Left(currentISRC,10)
num = CDbl(Right(currentISRC,5))
' Process all selected files
Set objSongList = SDB.SelectedSongList
' Save first selected filename
Set objSongData = objSongList.Item(0)
startFilename = FilenameFromPath(objSongData.Path)
For iCounter = 0 to objSongList.count - 1
Set objSongData = objSongList.Item(iCounter)
objSongData.ISRC = currentISRC 'Updates db and writes tags (if checked in options)
'If num has reached max of 99999, tell user and end process
If num = 99999 then
currentFilename = FilenameFromPath(objSongData.Path)
MsgBox "You have reached the highest available ISRC code in this series: " & currentISRC & _
vbCrLf & "This process has ended before assigning codes to all selected files." & _
vbCrLf & vbCrLf & "Assigned: " & _
vbCrLf & vbCrLf & startISRC & " (" & startFilename & ")" & _
vbCrLf & vbCrLf & "through" & _
vbCrLf & vbCrLf & currentISRC & " (" & currentFilename & ")",, "ISRC Assign Sequential"
objSonglist.UpdateAll
Exit Sub
Else
' Increment currentISRC
num = num + 1
currentISRC = prefix & PadDigits(CStr(num),5)
End If
Next
currentFilename = FilenameFromPath(objSongData.Path)
finalISRC = prefix & PadDigits(CStr(num-1),5)
MsgBox " Process complete. Assigned:" & _
vbCrLf & vbCrLf & startISRC & " (" & startFilename & ")" & _
vbCrLf & vbCrLf & "through" & _
vbCrLf & vbCrLf & finalISRC & " (" & currentFilename & ")",, "ISRC Assign Sequential"
End Sub
'function to specify leading zeros for a string
Function PadDigits(n, totalDigits)
PadDigits = Right(String(totalDigits,"0") & n, totalDigits)
End Function
'function to trim path to just filename
Function FilenameFromPath(path)
Dim pathCut, pathLength
pathCut = InStrRev(path,"\")
pathLength = len(path)
FilenameFromPath = Right(path,pathLength-pathCut)
End Function