' ===================== ' KeywordsToAlbumArtist ' ===================== ' Version 1.0.0.8 - June 17th 2016 ' Copyright © Steve MacGuire 2010-2016 ' http://samsoft.org.uk/iTunes/KeywordsToAlbumArtist.vbs ' Please visit http://samsoft.org.uk/iTunes/scripts.asp for updates ' ======= ' Licence ' ======= ' This program is free software: you can redistribute it and/or modify it under the terms ' of the GNU General Public License as published by the Free Software Foundation, either ' version 3 of the License, or (at your option) any later version. ' This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; ' without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. ' See the GNU General Public License for more details. ' Please visit http://www.gnu.org/licenses/gpl-3.0-standalone.html to view the GNU GPLv3 licence. ' =========== ' Description ' =========== ' A script for iTunes for Windows to add or remove keywords from the AlbumArtist field ' If required can easily be modified to update a different field by adjusting the working field ' See comments in the ProcessTracks subroutine ' Field keywords: , , , , , , , , , , , , ' , , , , , , , , . \n = newline ' Related scripts: KeywordsToAlbum.vbs, KeywordsToAlbumArtist.vbs, KeywordsToArtist.vbs, KeywordsToComments.vbs, KeywordsToComposer.vbs, ' KeywordsToDescription, KeywordsToGrouping.vbs, KeywordsToLyrics.vbs, KeywordsToName.vbs, KeywordsToShow, KeywordsToSortAlbum ' ========= ' ChangeLog ' ========= ' Version 1.0.0.1 - Initial version, prompted by this thread: http://discussions.apple.com/message.jspa?messageID=12039739#12039739 ' Version 1.0.0.2 - Tweak to support insertion of the file location into Grouping using as the keyword to be inserted ' Version 1.0.0.3 - Reverse processing loop to prevent out-of-bounds error if selection alters during processing ' Version 1.0.0.4 - Implement multiple keyword input and optional sorting of keywords, will now work with multi-character separator ' Version 1.0.0.5 - Added field replacement keywords & ' Version 1.0.0.6 - Changed method for inserting fields so a pattern like "Year: " can become "Year: 2010" ' - If not sorting can choose if new words are appended or prepended to existing value of the target field ' Version 1.0.0.7 - Added new keywords and more related scripts ' Version 1.0.0.8 - Added new keywords and more related scripts ' ========== ' To-do List ' ========== ' Add more things to do ' ============================= ' Declare constants & variables ' ============================= Option Explicit Const Min=1 ' Minimum number of tracks this script should work with Const Max=0 ' Maximum number of tracks this script should work with, 0 for no limit 'Dim CD ' Handle to CommonDialog object 'Dim FSO ' Handle to FileSystemObject Dim iTunes ' Handle to iTunes application 'Dim SH ' Handle to Shell application Dim nl ' New line string for messages Dim Title ' Message box title Dim Tracks ' A collection of track objects Dim Count ' The number of tracks Dim P,S,U ' Counters Dim Q ' Global flag Dim Dbg ' Manage debugging output Dim Opt ' Script options Dim Append ' Option to add keywords at end, if not sorting Dim Sorting ' Option for keyword sorting Dim Sep ' Keyword delimiter Dim Keyword ' Keyword to add or remove ' ======================= ' Initialise user options ' ======================= ' N.B. Edit Opt value to suit your needs. ' Control options, add bit values (x) for selective actions ' Bit 0 = Suppress dialog box for previews, just process tracks (1) ' Bit 1 = Suppress summary report (2) ' Bit 2 = Process entire library, otherwise try to restict to current playlist (4) Opt=0 ' Debug/report options, add bit values (x) for selective actions, initial value may be modified during run ' Bit 0 = Confirm actions (1) Dbg=0 ' Keyword separator, e.g. / , ; etc. should be a single character that you won't want to use inside keywords/phrases ' If target field supports multiple lines use Sep=" " & vbCrLf to have keywords listed on separate lines ' N.b. the space separates the words if iTunes displays the field on a single line in the browser e.g. with comments Sep=" " ' Option to have keywords sorted alphabetically, or added after or before existing content Sorting=False ' Probably not a good idea to sort the lyrics field in case it actually contains lyrics Append=True ' True to add keywords after existing content instead of before, unless sorting keywords are added in the order given ' ============ ' Main program ' ============ Init ' Set things up ProcessTracks ' Main process Report ' Summary ' =================== ' End of main program ' =================== ' =============================== ' Declare subroutines & functions ' =============================== ' Initialise track selections, quit script if track selection is out of bounds or user aborts ' Modified 2012-11-04 Sub Init Dim R,T ' Initialise global variables P=0 S=0 U=0 Q=False nl=vbCrLf Title="Keywords To AlbumArtist" ' Initialise global objects ' Set CD=CreateObject("UserAccounts.CommonDialog") ' Set FSO=CreateObject("Scripting.FileSystemObject") Set iTunes=CreateObject("iTunes.Application") ' Set SH=CreateObject("Shell.Application") Set Tracks=iTunes.SelectedTracks If Tracks is Nothing Then If (Opt AND 4) OR iTunes.BrowserWindow.SelectedPlaylist.Source.Name<>"Library" Then Set Tracks=iTunes.LibraryPlaylist.Tracks Else Set Tracks=iTunes.BrowserWindow.SelectedPlaylist.Tracks End If End If Count=Tracks.Count ' Check there is a suitable number of suitable tracks to work with IF CountMax And Max>0) Then If Max=0 Then MsgBox "Please select " & Min & " or more tracks in iTunes before calling this script!",0,Title WScript.Quit Else MsgBox "Please select between " & Min & " and " & Max & " tracks in iTunes before calling this script!",0,Title WScript.Quit End If End If ' Check if the user wants to proceed and get keywords T="Enter keyword to add to the AlbumArtist field for " & Count & " track" & Plural(Count,"s","") T=T & ", separate keywords with " If Sep=" " & nl Then T=T & "\n" ElseIf Sep=" " Then T=T & "a space" Else T=T & Sep End If T=T & " and/or prefix with - to remove a keyword." R=InputBox(T,Title) If R="" Then WScript.Quit Else R=Replace(R,"\n"," " & nl) ' Replace \n with space & newline R=Replace(R,"\N"," " & nl) ' Replace \N with space & newline Keyword=Replace(R," "," ") ' Remove any double spaces End If End Sub ' Add or remove keywords from string ' Modified 2016-06-17 Function Keywords(ByVal V,ByVal K,ByVal T) Dim R,S If Append Then S=InstrRev(K,Sep) Else S=Instr(K,Sep) End If If S>0 Then ' If more than one keyword, split & recurse If Append Then V=Keywords(V,Left(K,S-1),T) K=Mid(K,S+Len(Sep)) Else V=Keywords(V,Mid(K,S+Len(Sep)),T) K=Left(K,S-1) End If End If 'MsgBox "Input: " & K & " into " & V If Left(K,1)="-" Then R=True K=Mid(K,2) Else R=False End If ' Replace field names with their values, extend list as required IF Instr(K,"<") Then With Tracks.Item(T) K=Replace(K,"",.Album) K=Replace(K,"",.AlbumArtist) K=Replace(K,"",.Artist) K=Replace(K,"",.Comment) K=Replace(K,"",.Composer) K=Replace(K,"",.Description) K=Replace(K,"",Pad(.DiscNumber,.DiscCount)) K=Replace(K,"",.Genre) K=Replace(K,"",.Grouping) K=Replace(K,"",.Location) K=Replace(K,"",.Lyrics) K=Replace(K,"",.Name) K=Replace(K,"",.Name) K=Replace(K,"",.SortAlbum) K=Replace(K,"",.SortAlbumArtist) K=Replace(K,"",.SortArtist) K=Replace(K,"",.SortComposer) K=Replace(K,"",.SortName) K=Replace(K,"",.SortShow) K=Replace(K,"",Pad(.TrackNumber,.TrackCount)) K=Replace(K,"",.Year) End With End If If R Then ' If keyword begins "-" then remove it if found V=Replace(V,Sep & K & Sep,Sep) If V=Sep Then V=V & Sep Else ' Otherwise add the keyword if not already present IF V=Sep & Sep Then V=Sep & K & Sep ElseIf Instr(V,Sep & K & Sep)=0 Then If Append Then V=V & K & Sep ' Add keywords to end of list Else V=Sep & K & V ' Add keywords to front of list End If End If End If 'MsgBox "Output: " & V Keywords=V End Function ' Pad out number V to width of number W ' Modified 2014-12-31 Function Pad(V,W) Pad=V If Len(W & "")>Len(V & "") Then Pad=String(Len(W & "")-Len(V & ""),"0") & V End Function ' Return relevant string depending on whether value is plural or singular ' Modified 2010-09-18 Function Plural(V,P,S) If V=1 Then Plural=S ELSE Plural=P End Function ' Loop through track selection processing suitable items ' Modified 2012-11-04 Sub ProcessTracks Dim I,T,V For I=Count to 1 step -1 ' Work backwards to avoid index errors Set T=Tracks.Item(I) If T.Kind=1 Then ' Only process "File" tracks P=P+1 V=Sep & T.AlbumArtist & Sep ' Change working field here, V=Keywords(V,Keyword,I) V=Mid(V,Len(Sep)+1,Len(V)-2*Len(Sep)) If Sorting Then V=SortIt(V) If V<>T.AlbumArtist Then ' here U=U+1 T.AlbumArtist=V ' and here End If If Q Then Exit Sub End If Next End Sub ' Output report ' Modified 2010-09-18 Sub Report If (Opt AND 2) Then Exit Sub Dim T T=P & " track" & Plural(P,"s","") If P