Не вижу причин тянуть с ответом. Сделал так, как описал:
'•••••••••••••••••••••••••••••• VBS •••••••••••••••••••••••••••••••
' Переместить/переименовать MP3-файлы в рабочем каталоге по шаблону
'
' Условие: требуются MediaInfoActiveX.dll и MediaInfo.dll
'
' Ключи: /s:[<шаблон для перемещения/переименования>]
' /d:[<разделитель между тегами в шаблоне, если есть>]
' /c:<минимальное число mp3 для перемещения> (1 по умолч.)
' /o:[<путь назначения>] (рабочий каталог по умолч.)
'
' В шаблоне могут участвовать следующие теги:
' TrackNumber, Year, Title, Album, Artist, Genre
'
' Примеры ключей:
' 1) /s:"TrackNumber. Title" /d:". "
' 2) /s:"Artist\Artist - Title" /d:" - " /c:2
' 3) /s:"Artist\Year - Album\TrackNumber. Title" /d:" - "
' 4) /s:"Genre\Artist\Album - Title" /d:" - " /o:C:\Music
'••••••••••••••••••••••••••••••••••••••••••••• Автор: Flasher © •••
Option Explicit: Dim Scheme, Delim, Count, oDir
Dim T, WMP, STg, ShA, MIA, FSO, R, S, Dir, Disk
With WScript.Arguments.Named
If .Count < 2 Then Msg "Не задано ни одного ключа!", 4144
If Not .Exists("s") Then Msg "Ключ /s: обязателен!", 4144
Scheme = .Item("s")
If .Exists("d") Then Delim = .Item("d") : _
If InStr(Scheme, Delim) = 0 Then _
Msg "В шаблоне отсутствует разделитель '" & Delim & "'!", 4144
If .Exists("c") Then Count = .Item("c") Else Count = 0
If .Exists("o") Then oDir = .Item("o")
End With
Sub Msg(Text, Num)
MsgBox Text, Num, " Переименование (перемещение) MP3 " : WScript.Quit
End Sub
T = InStrRev(Scheme, "\") : Dim RScheme
If T Then
Dim Test : Test = InStr(Mid(Scheme, T), Delim)
RScheme = Mid(Scheme, T) & Left(Scheme, T)
Else Count = 0 : RScheme = Scheme End If
If Count > 1 Then Dim Dic : _
Set Dic = CreateObject("Scripting.Dictionary")
Set STg = CreateObject("Scripting.Dictionary")
Set ShA = CreateObject("Shell.Application")
Set MIA = CreateObject("MediaInfo.ActiveX")
Dim Reg : Set Reg = New RegExp : Reg.Global = True
Set FSO = CreateObject("Scripting.FileSystemObject")
R = Array(-230,-225,-246,698,894,-24,-24,706,707)
S = Split(": ? * "" ; / | < >")
Dir = FSO.GetAbsolutePathName("")
If IsEmpty(oDir) Then oDir = Dir
Set Disk = ShA.NameSpace(FSO.GetDriveName(Dir))
Set Dir = ShA.NameSpace(Dir) : Dim Items, F, Handle
Set Items = Dir.Items : Items.Filter 90304, "*.mp3"
If Items.Count = 0 Then Msg "В каталоге нет MP3-файлов!", 4144
For Each F in Split("Year TrackNumber Title Album Artist Genre")
If InStr(RScheme, F) > 0 Then STg.Add F, ""
Next : Handle = MIA.MediaInfo_New()
Dim rPath, Arr, Check, i, n, c, Tag, RelPath, Path, BN, Ext, Name, Pr
For Each F in Items
MIA.MediaInfo_Open Handle, F.Path : rPath = Scheme : c = 0
Arr = Split(FSO.GetBaseName(F), Delim) : Check = 1
For Each i in STg.Keys
n = i
Select Case i
Case "Year" n = "Recorded_Date"
Case "TrackNumber" n = "Track/Position"
End Select
MIA.MediaInfo_Option Handle, "Inform", "General;%" & n & "%"
Tag = Trim(MIA.MediaInfo_Inform(Handle, 0))
If i = "TrackNumber" Then Reg.Pattern = "^0+" : Tag = Reg.Replace(Tag, "")
If Tag = "" And Delim <> "" Then
If UBound(Arr) + 1 = STg.Count Then Tag = Arr(c) Else Check = 0 : Exit For
End If
rPath = Replace(rPath, i, Tag) : c = c + 1
Next
If Check Then
For Each i in Array("[ \.\(\{-]+\\+", "\\+[ \.\)\}-]+", "\\{2,}")
Reg.Pattern = i : rPath = Reg.Replace(rPath, "\")
Next
For i = 0 To 8 : rPath = Replace(rPath, S(i), ChrW(R(i))) : Next
RelPath = Left(rPath, InStrRev(rPath, "\"))
Path = FSO.BuildPath(oDir, RelPath)
If (Not Test Or (Test And InStr(RelPath, Delim) > 0)) And Right(rPath, 1) <> "\" Then
If Not FSO.FolderExists(Path) Then Disk.NewFolder(Mid(Path, 4))
BN = FSO.GetFileName(rPath) : Ext = "." & FSO.GetExtensionName(F)
Name = BN & Ext : c = 0 : Pr = ""
If Len(FSO.BuildPath(Path, Name)) > 259 Then Pr = "\\?\"
If T Then
While FSO.FileExists(Pr & FSO.BuildPath(Path, Name))
c = c + 1 : Name = BN & " (" & c & ")" & Ext
Wend
End If : FSO.GetFile(F.Path).Move Pr & FSO.BuildPath(Path, Name)
If Count > 1 Then If Not Dic.Exists(Path) Then Dic.Add Path, ""
End If
End If
Next
If Count > 1 Then
For Each I in Dic.Keys
Set Items = ShA.NameSpace(I).Items
Items.Filter 90304, "*.mp3"
If Items.Count < CLng(Count) Then _
Dir.MoveHere Items, 20 : FSO.GetFolder(I).Delete
Next : Dic.RemoveAll
End If : Msg "Файлы переименованы/перемещены!", 4160
А насчёт частого обращения - можно сделать кнопку вызова по шаблону и автонажатия Enter.
