' ===========
' SwitchLinks
' ===========

' Version 1.0.1.3 - September 18th 2011
' Copyright © Steve MacGuire 2010-2001
' http://samsoft.org.uk/iTunes/SwitchLinks.vbs


' =======
' 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 VBScript to switch links between duplicate copies of media
' E.g. if library has been manually copied to a new path and then consolidated to the same path
' Works with selected track, selected playlist or, optionally, with entire library

' Written in response to this thread in Apple Discussions in particular, but also in the light of having seen other similar posts
' http://discussions.apple.com/message.jspa?messageID=11838659
' http://discussions.apple.com/thread.jspa?threadID=2544500

' =========
' ChangeLog
' =========

' Version 1.0.0.1 - Initial version
' Version 1.0.0.2 - GNU GPLv3.0 Release
' Version 1.0.0.3 - Detects & relinks "relocated" files if they are where they "ought" to be,
'		    or otherwise allow user to attempt to relocate them
' Version 1.0.0.4 - Auto-determines media location and "iTUnes Media Orgainsation" status
' Version 1.0.0.5 - Adjust for lack of Common Dialog Object in Vista/Window 7
' Version 1.0.1.1 - Major rewrite to cope with mix of long and iTunes limited-length file and folder names
'                   Improved path evaluation, tests potential candiate folders for each album
' Version 1.0.1.2 - Fixed bug where tracks with no genre were treated as missing "Books"
'		    Added ability to detect tracks with missing track numbers
' Version 1.0.1.3 - Updated to prompt for media folder location



' Visit http://samsoft.org.uk/iTunes/scripts.asp for updates


' ==========
' To-do List
' ==========

' Add checks when switching links to avoid potential mistakes, e.g. test both files are same size
' Look for other potential "gotchas"



' =============================
' 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 A,M,N,P,S,U		' Counters
Dim Q			' Global flag
Dim Root		' Root of media library
Dim Archive		' Folder for archived files
Dim Dbg			' Manage debugging output
Dim Opt			' Script options
Dim Org			' "Media Organisation" flag


' =======================
' 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 update tracks					(1)
' Bit 1 = Suppress summary report								(2)
' Bit 2 = Process entire library, otherwise try to restict to current playlist			(4)

Opt=4

' Debug/report options, add bit values (x) for selective actions, initial value may be modified during run
' Bit 0 = Confirm relinks									(1)

Dbg=0


' ============
' Main program
' ============

  Init			' Set things up
  ProcessTracks		' Main process 
  Report		' Summary

' ===================
' End of main program
' ===================



' ===============================
' Declare subroutines & functions
' ===============================


' Browse for a file. UserAccounts.CommonDialog works on XP only!
' Error trapped for other systems to use vbScript InputBox
Function BrowseForFile(Path,Name,Ext)
  Dim CD,File,R,T,W
  BrowseForFile=""
  W=""
  T="Cannot locate file: " & Name
  If Len(Ext)>5 Then
    T=T & nl & "with possible file types: "
  Else
    Name=Name & Ext
  End If
  T=T & Ext & nl & "in folder: " & Path & nl & nl
  T=T & "Would you like to try to find the correct file now?"
  R=MsgBox(T,vbYesNoCancel+vbQuestion,title)
  If R=vbCancel Then Q=True : Exit Function
  IF R=vbNo Then Exit Function

  'On Error Resume Next
  'Set CD=CreateObject("UserAccounts.CommonDialog")	' XP Only!
  'Set CD=CreateObject("MSComDlg.CommonDialog")		' Vista/Windows 7 with MS Office Or Visual Studio? 

  'If Err.Number<>0 Then
    'Err.Clear
  T=W & "Please edit/correct the full path for the file that was expected to be found here:" & nl & nl & Path & "\" & Name
  If Len(Ext)>5 Then T=T & nl & "with possible file types: " & Ext : Name=Name & "."
  Do
    BrowseForFile=InputBox(W & T,Title,Path & "\" & Name)
    IF W="" Then W="File not found!" & nl & nl
  Loop Until FSO.FileExists(BrowseForFile) Or BrowseForFile=""
  'Else  
  '  Do While FSO.FolderExists(Path)=False And Instr(Path,"\")
  '    Path=Left(Path,InStrRev(Path,"\")-1)
  '  Loop
  '  CD.Filter="All Files|*.*"
  '  CD.FilterIndex=1
  '  'CD.InitialDir=Path					' XP Only
  '  CD.InitDir=Path					' Vista/Windows 7 with MS Office Or Visual Studio? 
  '  File=CD.ShowOpen
  '  If File=False Then
  '    BrowseForFile=""
  '  Else
  '    BrowseForFile=CD.FileName
  '  End If 
  'End If
  'On Error Goto 0
End Function


' Find a file in Path that is a partial match to Target.Ext as long as only one such match exists
' Ext may contain multiple possible file extensions
Function FindFile(Path,Target,Ext)
  FindFile=""
  IF FSO.FolderExists(Path) Then
    Dim E,F,M,P,T,N
    M=0
    Set F=FSO.GetFolder(Path)
    T=Ext
    Do While Instr(T,".")>0 AND M<2
      E=Mid(T,InstrRev(T,"."))
      T=Left(T,Len(T)-Len(E))
      For Each S in F.Files
        N=S.Name
        P=InstrRev(N,".")
        If P>1 Then N=Left(N,P-1)
        If Right(S.Name,Len(E))=E And Left(N,Len(Target))=Left(Target,Len(N)) Then
          FindFile=Path & "\" & S.Name
          M=M+1
        End If
      Next
    Loop
    ' Comment out next line if uniqueness is not required, will then return last match found
    If M>1 Then FindFile=""
  End If
End Function


' Find a subfolder of Path that is a partial match to Target as long as only one such match exists
Function FindFolder(Path,Target)
  FindFolder=""
  IF FSO.FolderExists(Path) Then
    Dim F,M
    M=0
    IF FSO.FolderExists(Path & "\" & Target) Then
      FindFolder=Path & "\" & Target
    Else
      Set F=FSO.GetFolder(Path)
      For Each S in F.SubFolders
        If Left(S.Name,Len(Target))=Left(Target,Len(S.Name)) Then
          FindFolder=Path & "\" & S.Name
          M=M+1
        End If
      Next
    End If 
    ' Comment out next line if uniqueness is not required, will then return last match found
    If M>1 Then FindFolder=""
  End If
End Function


' Attempt to determine root of media path by inspecting location of media files
Function GetMediaPath()
  Dim A,C,I,L,P,S,T,Tracks
  Set Tracks=iTunes.LibraryPlaylist.Tracks
  C=Tracks.Count
  If C>100 Then C=100		' Give up if can't find one valid location in the first 100 attempts
  I=1
  P=""
  Do
    Set T=Tracks.Item(I)
    If T.Kind=1 Then		' Only process "File" tracks
      With T
        L=.Location
        IF L<>"" Then
          A=.AlbumArtist
          IF A="" Then A=.Artist
          A=ValidiTunes(A,"")
          If .Compilation Then A="Compilations"
          If .Podcast Then
            A=ValidiTunes(.Album,"")
          ElseIf .VideoKind=1 Then
            A=ValidiTunes(.Name,"")
          ElseIf .VideoKind=3 Then
            A=ValidiTunes(.Show,"")
          End If
          If Instr(L,A) Then
            P=Left(L,Instr(L,A)-2)
            S=Mid(P,InStrRev(P,"\"))
            If Instr("\Audiobooks\Books\iPod Games\iTunes U\Mobile Applications\Movies\Music\Podcasts\Ringtones\TV Shows",S) Then P=Left(P,Len(P)-Len(S))
          'Else
          ' MsgBox "Artist:" & .Artist & nl & "Name:" & .Name & nl & "Location:" & .Location
          End If
        End If
      End With
    End If
    I=I+1
  Loop Until P<>"" OR I>C
  ' MsgBox "Media path is " & P & nl & "Found in " & I-1 & " step" & Plural(I-1,"s","")
  GetMediaPath=P
End Function


' Initialise track selections, quit script if track selection is out of bounds or user aborts
Sub Init
  Dim R,T
  ' Initialise global variables
  A=0
  M=0
  N=0
  P=0
  S=0
  U=0
  Q=False
  nl=vbCr & vbLf
  Title="Switch Links"
  ' Initialise global objects
  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 Count<Min Or (Count>Max 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 how
  If (Opt AND 1)=0 Then
    T="Attempt to switch links for " & Count & " track" & Plural(Count,"s","") & "?" & nl & nl & _
      "Yes : Switch link" & Plural(Count,"s","") & " automatically" & nl & _
      "No : Preview & confirm each switch" & nl & _
      "Cancel : Abort script"
    'T=T & nl & nl & "NB: Disable ''Keep iTunes Media folder organised'' preference before use."
    R=MsgBox(T,vbYesNoCancel+vbQuestion,Title)
    If R=vbCancel Then WScript.Quit
    If R=vbYes Then
      Dbg=0
    Else
      Dbg=Dbg OR 1
    End If
  End If
  
  Root=GetMediaPath
  IF Root="" Then Root=iTunes.LibraryXMLPath
  Do
    Root=Left(Root,InStrRev(Root,"\")-1)
    If FSO.FolderExists(Root & "\iTunes Media") Then Root=Root & "\iTunes Media"
    If FSO.FolderExists(Root & "\iTunes Music") Then Root=Root & "\iTunes Music"
    Root=InputBox("Please confirm/edit the location of your media folder",Title,Root)
    If Right(Root,1)="\" Then Root=Left(Root,Len(Root)-1)
    If Root="" Then WScript.Quit
  Loop Until FSO.FolderExists(Root)
  If FSO.FolderExists(Root & "\Music") Then
    Org=True
  Else
    Org=False
  End If
  Archive=FSO.GetParentFolderName(Root) & "\Dupes"
End Sub


' Create a folder path if it doesn't already exist
Function MakePath(Path)
  ' Default result
  MakePath=False
  ' Fail if drive is not valid
  If Not FSO.DriveExists(FSO.GetDriveName(Path)) Then Exit Function
  ' Succeed if folder exists
  If FSO.FolderExists(Path) Then
    MakePath=True
    Exit Function
  End If
  ' Call self to ensure parent path exists
  If Not MakePath(FSO.GetParentFolderName(Path)) Then Exit function
  ' Create folder
  On Error Resume Next
  FSO.CreateFolder Path
  On Error Goto 0   
  MakePath=FSO.FolderExists(Path)
End Function


' Return relevant string depending on whether value is plural or singular
Function Plural(V,P,S)
  If V=1 Then Plural=S ELSE Plural=P
End Function


' Loop through track selection processing suitable items
Sub ProcessTracks
Dim I,T
  For I=1 to Count
    Set T=Tracks.Item(I)
    If T.Kind=1 Then		' Only process "File" tracks
      SwitchLink(T)
      IF Q Then Exit Sub
    End If
  Next
End Sub


' Output report
Sub Report
  If (Opt AND 2) Then Exit Sub
  Dim T
  T=P & " track" & Plural(P,"s","")
  If P<Count Then T=T & " of " & count
  T=T & Plural(P," were"," was") & " processed of which " & nl
  IF N>0 Then T=T & N & " already had the correct filename" & Plural(N,"s","") & nl
  IF M>0 Then T=T & M & Plural(M," were"," was") & " missing in action" & nl
  T=T & U & Plural(U," were"," was") & " updated"
  IF S>0 Then T=T & " and " & nl & S & Plural(S," were"," was") & " skipped"
  If A>0 Then T=T & nl & A & " file" & Plural(A,"s were"," was") & " archived"
  T=T & "."
  If A>0 Then T=T & nl & nl & "Please check your library before deleting the dupes folder!" & nl & "(Will open on exit)"
  MsgBox T,vbInformation,Title
  If A>0 Then SH.Explore Archive
End Sub


' Look for duplicate files and switch association if found
' Dupes created by consolidation or giving two files the same details end " 1"
' Dupes created by copying into Automatically add to iTunes folder end " 2", " 3" etc.
Sub SwitchLink(Track)
  Dim AltName,ArcFolder,ArcPath,Ext,Folder,Name,NewPath,R,T,ValidAlbum,ValidArtist
  With Track
    If .Location="" Then

      ' The following test line is used because it is easier to break files by renaming them and then restore the correct name than it is to actually
      ' recreate the conditions in which the file is in the correct path, but iTunes is looking at the old path on the wrong drive.
      ' MsgBox "Restore the 'broken' file then click OK to have it automatically detected by the script" & nl & nl & "If test is OK comment out this line!"

      ' Try to find relocated file
      M=M+1

      ' Determine file extension - .mp3 .mp4 .m4a .m4b .m4p .m4v .mov .mpg .mpeg .wav .aif .mid .ipa .ipg .ite .itlp .m4r .epub .pdf
      Select Case .KindAsString
      Case "AAC audio file","Apple Lossless audio file","Purchased AAC audio file"
         Ext=".m4a"
      Case "AIFF audio file"
         Ext=".aif"
      Case "Book","Purchased book"
         Ext=".epub"
      Case "iPad app","iPhone/iPod touch app","iPhone/iPod touch/iPad app"
         Ext=".ipa"
      Case "iPod game"
         Ext=".ipg"
      Case "iTunes Extras"
         Ext=".ite"
      Case "iTunes LP"
         Ext=".itlp"
      Case "MPEG audio file"
         Ext=".mp3"
      Case "MPEG-4 video file","Protected MPEG-4 video file"
         Ext=".m4v.mp4"
      Case "PDF document"
         Ext=".pdf"
      Case "Protected AAC audio file"
         Ext=".m4b.m4p"
      Case "QuickTime movie file"
         Ext=".mid.mov.mpg.mpeg"
      Case "Ringtone"
         Ext=".m4r"
      Case "WAV audio file"
         Ext=".wav"
      Case Else
         Ext=""
         MsgBox "This script needs updating to generate correct the extension for files of type:" & nl & .KindAsString,0,Title
      End Select

      ' Determine path
      NewPath=""
      ValidArtist=ValidiTunes(.AlbumArtist,"")
      If ValidArtist="" Then ValidArtist=ValidiTunes(.Artist,"")
      If ValidArtist="" Then ValidArtist="Unknown Artist"
      ValidAlbum=ValidiTunes(.Album,"")
      If ValidAlbum="" Then ValidAlbum="Unknown Album"
      If .Podcast=True Then
        ' MsgBox "Found Podcast"
        ' NewPath=Root & "\Podcasts\" & ValidAlbum
        NewPath=FindFolder(Root & "\Podcasts",ValidAlbum)
      ElseIf .VideoKind=1 Then
        ' MsgBox "Found Movie"
        If ValidAlbum="Unknown Album" Then ValidAlbum=ValidiTunes(.Name,"")
        NewPath=Root & "\Movies"
        Folder=FindFolder(NewPath,ValidAlbum)
        IF FSO.FolderExists(Folder) Then NewPath=Folder
      ElseIf .VideoKind=3 Then
        ' MsgBox "Found TV Show"
        NewPath=FindFolder(Root & "\TV Shows",ValidiTunes(.Show,""))
        If .SeasonNumber>0 Then Folder=NewPath & "\Season " & .SeasonNumber
        IF FSO.FolderExists(Folder) Then NewPath=Folder
      ElseIf (.Genre<>"" AND Instr("Reference",.Genre)) OR Ext=".epub" Then
        ' MsgBox "Found Book"
        NewPath=FindFolder(Root & "\Books",ValidArtist)
      ElseIf (.Genre<>"" AND Instr("Audiobook/Books & Spoken",.Genre)) OR Ext=".m4b" Then
        ' MsgBox "Found Audiobook"
        NewPath=FindFolder(Root & "\AudioBooks",ValidArtist)
        Folder=FindFolder(NewPath,ValidAlbum)
        IF FSO.FolderExists(Folder) Then NewPath=Folder
      Else
        ' MsgBox "Found Music"
        ' Test possible alternate locations for an album until found, e.g. pre/post iTunes Media organisation or
        ' albums whose location incorrectly reflects their Compliation status. Could add alternate locations here.
        ' May fail to automatically locate some tracks if the album is split across two folders
        If .Compilation Then
          If NewPath="" Then NewPath=FindFolder(Root & "\Compilations",ValidAlbum)
          If NewPath="" Then NewPath=FindFolder(Root & "\Music\Compilations",ValidAlbum)
          If NewPath="" Then NewPath=FindFolder(Root & "\Music",ValidArtist) : NewPath=FindFolder(NewPath,ValidAlbum)
          If NewPath="" Then NewPath=FindFolder(Root,ValidArtist) : NewPath=FindFolder(NewPath,ValidAlbum)
        Else
          If NewPath="" Then NewPath=FindFolder(Root,ValidArtist) : NewPath=FindFolder(NewPath,ValidAlbum)
          If NewPath="" Then NewPath=FindFolder(Root & "\Music",ValidArtist) : NewPath=FindFolder(NewPath,ValidAlbum)
          If NewPath="" Then NewPath=FindFolder(Root & "\Music\Compilations",ValidAlbum)
          If NewPath="" Then NewPath=FindFolder(Root & "\Compilations",ValidAlbum)
        End If
      End If

      If NewPath="" Then 
        MsgBox "No candiate folder found"
        NewPath=Root
      End If

      ' Determine iTunes-like filename with leading track/disc numbers
      Name=.Name
      If .TrackNumber>0 Then
        Name=.TrackNumber & " " & Name
        If .TrackNumber<10 Then Name="0" & Name
        If .DiscNumber>1 Or (.DiscNumber=1 AND .DiscCount>1) Then Name=.DiscNumber & "-" & Name
      End If
      Name=ValidiTunes(Name,"")

      ' Now try to find that file!
      Folder=NewPath
      ' MsgBox "Folder: " & Folder & nl & "Name: " & Name & nl & "Ext: " & Ext,vbInformation,Title
      NewPath=FindFile(NewPath,Name,Ext)
      If NewPath="" AND .Tracknumber>0 Then		' Test for file without leading track number
	NewPath=FindFile(Folder,ValidiTunes(.Name,""),Ext)
      End If

      If FSO.FileExists(NewPath) Then
        R=True
        If (Dbg And 1) Then
          T="Reconnect " & .Artist & " - " & .Album & " - " & .Name & " to:" & nl & NewPath
          R=MsgBox(T,vbYesNoCancel+vbQuestion,title)
          If R=vbCancel Then Q=True : Exit Sub
          IF R=vbYes Then
            R=True
          Else
            R=False
            S=S+1
          End If
        End If
        If R=True Then
          .Location=NewPath
          U=U+1
        End If
      Else
        ' Try to manually find file
        NewPath=BrowseForFile(Folder,Name,Ext)
        If NewPath="" Then
          S=S+1
        Else
          .Location=NewPath
          U=U+1
        End If
      End If

    Else

      ' Switch link to file without trailing " 1"/" 2"
      Ext=LCase(Mid(.Location,InStrRev(.Location,".")))
      Folder=Left(.Location,InStrRev(.Location,"\")-1)
      Name=Mid(.Location,Len(Folder)+2)
      Name=Left(Name,Len(Name)-Len(Ext))
      If Right(Name,2)=" 1" Or Right(Name,2)=" 2" Then
        NewPath=Folder & "\" & Left(Name,Len(Name)-2) & Ext
	IF FSO.FileExists(NewPath) Then
          R=True
          If (Dbg And 1) Then
            T="Switch link from the file at:" & nl & .Location & nl & nl & "To:" & nl & NewPath
            R=MsgBox(T,vbYesNoCancel+vbQuestion,title)
            If R=vbCancel Then Q=True : Exit Sub
            IF R=vbYes Then
              R=True
            Else
              R=False
              S=S+1
            End If
          End If
          If R=True Then
            'Archive old file before switching link
	    ArcPath=Replace(.Location,Root,Archive)
            ArcFolder=Replace(Folder,Root,Archive)
            MakePath(ArcFolder)
            FSO.MoveFile .Location,ArcPath
	    A=A+1
            .Location=NewPath
            U=U+1
          End If
        Else
          N=N+1	' File not a real dupe, no update 
        End If
      Else
        N=N+1	' File didn't need updating
      End If
    End If
  End With
  P=P+1
End Sub


' Replace invalid filename characters: \ / : * ? " < > | and also ; with underscores
' Replace leading space or period, strip trailing spaces, trailing periods allowed except for folders
' File names (inclusive of extention) & folder names limited to 40 characters
' A name consisting only of spaces has the leading space changed to an underscore
' Pass name and extention, extention="" for folders

Function ValidiTunes(N,E)
  ' N=Left(N,40-Len(E))		' It may help not to automatically truncate names and let FindFile/FindFolder do the work
  N=Replace(N,"\","_")
  N=Replace(N,"/","_")
  N=Replace(N,":","_")
  N=Replace(N,"*","_")
  N=Replace(N,"?","_")
  N=Replace(N,"""","_")
  N=Replace(N,"<","_")
  N=Replace(N,">","_")
  N=Replace(N,"|","_")
  N=Replace(N,";","_")
  IF N=String(Len(N)," ") Then
    N=N="_" & Mid(N,2)
  Else
    Do While Right(N,1)=" "
      N=Left(N,Len(N)-1)
    Loop 
    If Left(N,1)=" " Or Left(N,1)="." Then N="_" & Mid(N,2)
    If E="" And Right(N,1)="." Then N=Left(N,Len(N)-1) & "_"
  End If
  ValidiTunes=N & E
End Function


' Replace invalid filename characters: \ / : * ? " < > | per http://support.microsoft.com/kb/177506
' Strip leading/trailing spaces & leading periods, trailing periods allowed except for folders
' Change the replacement characters on the right for other valid characters if required
' A name consisting only of spaces or periods is changed to a single underscore
' Pass name and extention, extention="" for folders

Function ValidName(N,E)
  N=Replace(N,"\","-")
  N=Replace(N,"/","-")
  N=Replace(N,":",";")
  N=Replace(N,"*","-")
  N=Replace(N,"?","")
  N=Replace(N,"""","''")
  N=Replace(N,"<","{")
  N=Replace(N,">","}")
  N=Replace(N,"|","!")
  Do While (Left(N,1)=" " Or Left(N,1)=".")
    N=Mid(N,2)
    If N=" " Or N="." Then N="_" ' Prevent name from vanishing
  Loop 
  Do While Right(N,1)=" " Or (E="" And Right(N,1)=".")
    N=Left(N,Len(N)-1)
  ' If N=" " Or N="." Then N="_" ' Prevent name from vanishing - Redundant!
  Loop 
  ValidName=N & E
End Function


' Moves any leading "The " to the end of the string so folder order matches
' iTunes sorting (more or less) while still showing the full title.
Function TheValidName(N,E)
  N=ValidName(N,E)
  If Left(N,4)="The " Then N=Mid(N,5) & ", The"
  TheValidName=N & E
End Function


' ==============
' End of listing
' ==============