MP3 Dateien umbenennen 5

MP3 Dateien umbenennen

und: ID3-V2 Tags auslesen

Wer kennt das nicht: Da liegen nun die MP3 Dateien in schönster Ordnung auf der Festplatte, die Dateinamen sind alle gemäß den persönlichen Vorgaben und nach dem Überspielen auf den MP3 Player stellt sich heraus, dass die Dateinamen hierfür sehr unpraktisch sind. Player, die bei der Navigation die Ordnerstruktur verwenden, bieten oft nicht genug Platz im Display, um auf den ersten Blick den Song zu erkennen.
Hier wäre es zum Beispiel hilfreich, die Tracknummer, den Titel und dann erst den Interpreten im Dateinamen zu sehen. Vielleicht gibt es auch noch andere Vorstellungen, je nachdem wie die Ordnerstruktur aufgebaut ist.
Sicher gibt es dafür eine Menge Programme, die diese Aufgabe mehr oder weniger komfortabel erledigen. Aber welches ist für diesen Zweck das beste? Eines steht jedoch fest: die Dateien manuell umzubenennen, ist die denkbar schlechteste Alternative.

Auf diesen Seiten stelle ich nun ein VBA-Programm vor, welches genau diese Arbeit "halbautomatisch" erledigt. Halbautomatisch deshalb, weil vor dem Speichern das Ergebnis als Vorschlag angezeigt wird, noch geändert werden kann und erst dann auf Knopfdruck gespeichert wird.

An dieser Stelle möchte ich meinen Dank all jenen aussprechen, die unzählige Beiträge zu diesem Thema auf ihren Webseiten vorgestellt haben. Immer da, wo ich nicht mehr weiter wusste, habe ich Codeschnipsel übernommen und angepasst und hoffe, dass für andere meine Seite nun genauso hilfreich ist.

Zu diesem Programm gibt es eine Readme-Datei, die ich allen empfehle, die die Excel-Datei (als ZIP gepackt - 46 KB) herunterladen und als ganzes ausprobieren möchten.

Modul1 Modul2 Modul3 CommandButtons Menü

OK, die Readme ist noch nicht fertig. Ich arbeite gerade daran.

Ausserdem gibt es noch ein paar nötige Nachbesserungen:
- Wenn es mehr, als einen Punkt im Dateinamen gibt
- Trennzeichen ohne Leerzeichen davor und/oder dahinter
Das sind aber nur Kleinigkeiten.

- Ein kleiner Bug in der Menükontrolle wurde beseitigt

Screenshot1 Screenshot2 Screenshot3

Private Sub Workbook_Open()

Dim cbSpecialMenu As CommandBarPopup
Dim UMenu As CommandBarPopup
Dim cbCommand As CommandBarControl
Dim UcbCommand As CommandBarControl

On Error Resume Next
Application.CommandBars("Worksheet Menu " & _
"Bar").Controls("MP3-Menü-1").Delete
'Application.CommandBars("Worksheet Menu " & _
'"Bar").Controls("Spezialmenü-1").Delete

  Set cbSpecialMenu = _
  Application.CommandBars("Worksheet Menu Bar") _
  .Controls.Add(Type:=msoControlPopup)
  cbSpecialMenu.Caption = "MP3-Menü-1"
  cbSpecialMenu.TooltipText = "Spezialmenü für diese Arbeitsmappe"

  Set cbCommand = _
  cbSpecialMenu.Controls.Add(Type:=msoControlButton)
  cbCommand.Caption = "&1   Pfad manuell angeben"
  cbCommand.OnAction = "Pfad_angeben"

  Set cbCommand = _
  cbSpecialMenu.Controls.Add(Type:=msoControlButton)
  cbCommand.Caption = "&1   Pfad per Dialog einlesen"
  cbCommand.OnAction = "Pfad_einlesen"

  Set cbCommand = _
  cbSpecialMenu.Controls.Add(Type:=msoControlButton)
  cbCommand.Caption = "&2a  Dateinamen holen"
  cbCommand.OnAction = "Dateinamen_auslesen"
  cbCommand.BeginGroup = True

  Set cbCommand = _
  cbSpecialMenu.Controls.Add(Type:=msoControlButton)
  cbCommand.Caption = "&2b  Trennzeichen zählen"
  cbCommand.OnAction = "Trennzeichen_zaehlen"

  Set cbCommand = _
  cbSpecialMenu.Controls.Add(Type:=msoControlButton)
  cbCommand.Caption = "&2c  Dateinamen zur manuellen Bearbeitung kopieren"
  cbCommand.OnAction = "Dateinamen_kopieren"

  Set cbCommand = _
  cbSpecialMenu.Controls.Add(Type:=msoControlButton)
  cbCommand.Caption = "&2d  Dateinamen ohne erstes Trennzeichen kopieren"
  cbCommand.OnAction = "Dateinamen_kopieren_ohne_ETZ"

  Set cbCommand = _
  cbSpecialMenu.Controls.Add(Type:=msoControlButton)
  cbCommand.Caption = "&2e  im neuen Dateinamen erstes Trennzeichen löschen"
  cbCommand.OnAction = "ETZ_loeschen"

  Set UMenu = _
  cbSpecialMenu.Controls.Add(Type:=msoControlPopup)
  UMenu.Caption = "&3a  von Interpret-Titel-Track Nr. nach..."
  UMenu.BeginGroup = True

  Set UcbCommand = _
  UMenu.Controls.Add(Type:=msoControlButton)
  UcbCommand.Caption = "a...Track Nr.-Interpret-Titel"
  UcbCommand.OnAction = "Drei_aa"

  Set UMenu = _
  cbSpecialMenu.Controls.Add(Type:=msoControlPopup)
  UMenu.Caption = "&3b  von Interpret-Track Nr.-Titel nach..."

  Set UcbCommand = _
  UMenu.Controls.Add(Type:=msoControlButton)
  UcbCommand.Caption = "a...Track Nr.-Interpret-Titel"
  UcbCommand.OnAction = "Drei_ba"

  Set UMenu = _
  cbSpecialMenu.Controls.Add(Type:=msoControlPopup)
  UMenu.Caption = "&3c  von Track Nr.-Titel-Interpret nach..."

  Set UcbCommand = _
  UMenu.Controls.Add(Type:=msoControlButton)
  UcbCommand.Caption = "a...Track Nr.-Interpret-Titel"
  UcbCommand.OnAction = "Drei_ca"

'  Set UcbCommand = _
'  UMenu.Controls.Add(Type:=msoControlButton)
'  UcbCommand.Caption = "b...Track Nr. Interpret-Titel (Ohne erstes TZ)"
'  UcbCommand.OnAction = "Drei_cb"

  Set UMenu = _
  cbSpecialMenu.Controls.Add(Type:=msoControlPopup)
  UMenu.Caption = "&3d  von Track Nr.-Interpret-Titel nach..."

  Set UcbCommand = _
  UMenu.Controls.Add(Type:=msoControlButton)
  UcbCommand.Caption = "a...Interpret-Titel-Track Nr."
  UcbCommand.OnAction = "Drei_da"

  Set UcbCommand = _
  UMenu.Controls.Add(Type:=msoControlButton)
  UcbCommand.Caption = "b...Track Nr.-Titel-Interpret"
  UcbCommand.OnAction = "Drei_db"

  Set UMenu = _
  cbSpecialMenu.Controls.Add(Type:=msoControlPopup)
  UMenu.Caption = "&3e  von Interpret-Titel nach..."

  Set UcbCommand = _
  UMenu.Controls.Add(Type:=msoControlButton)
  UcbCommand.Caption = "a...Track Nr. manuell-Interpret-Titel"
  UcbCommand.OnAction = "Drei_ea"

  Set UMenu = _
  cbSpecialMenu.Controls.Add(Type:=msoControlPopup)
  UMenu.Caption = "&3f  von Titel-Interpret nach..."

  Set UcbCommand = _
  UMenu.Controls.Add(Type:=msoControlButton)
  UcbCommand.Caption = "a...Track Nr. manuell-Interpret-Titel"
  UcbCommand.OnAction = "Drei_fa"

  Set cbCommand = _
  cbSpecialMenu.Controls.Add(Type:=msoControlButton)
  cbCommand.Caption = "&4a  Groß/Klein-Schreibweise"
  cbCommand.OnAction = "umwandeln_in_GK_Schreibung"
  cbCommand.BeginGroup = True

  Set UMenu = _
  cbSpecialMenu.Controls.Add(Type:=msoControlPopup)
  UMenu.Caption = "&5b  ID3v2 Tag auslesen"

  Set UcbCommand = _
  UMenu.Controls.Add(Type:=msoControlButton)
  UcbCommand.Caption = "a   Tracknummer"
  UcbCommand.OnAction = "ID_TAG_1_auslesen"

  Set UcbCommand = _
  UMenu.Controls.Add(Type:=msoControlButton)
  UcbCommand.Caption = "b   Interpret"
  UcbCommand.OnAction = "ID_TAG_2_auslesen"

  Set UcbCommand = _
  UMenu.Controls.Add(Type:=msoControlButton)
  UcbCommand.Caption = "c   Titel"
  UcbCommand.OnAction = "ID_TAG_3_auslesen"

  Set UcbCommand = _
  UMenu.Controls.Add(Type:=msoControlButton)
  UcbCommand.Caption = "d   Dateiendung"
  UcbCommand.OnAction = "ID_TAG_4_auslesen"

  Set UMenu = _
  cbSpecialMenu.Controls.Add(Type:=msoControlPopup)
  UMenu.Caption = "&6   neue Dateinamen erstellen"

  Set UcbCommand = _
  UMenu.Controls.Add(Type:=msoControlButton)
  UcbCommand.Caption = "&a...mit erstem Trennzeichen"
  UcbCommand.OnAction = "DNE_ETZ_true"

  Set UcbCommand = _
  UMenu.Controls.Add(Type:=msoControlButton)
  UcbCommand.Caption = "&b...ohne erstes Trennzeichen"
  UcbCommand.OnAction = "DNE_ETZ_false"

  Set cbCommand = _
  cbSpecialMenu.Controls.Add(Type:=msoControlButton)
  cbCommand.Caption = "&7   Änderungen speichern"
  cbCommand.OnAction = "Dateien_umbenennen"
  cbCommand.BeginGroup = True

  Set UMenu = _
  cbSpecialMenu.Controls.Add(Type:=msoControlPopup)
  UMenu.Caption = "&8   Löschen"
  UMenu.BeginGroup = True

  Set UcbCommand = _
  UMenu.Controls.Add(Type:=msoControlButton)
  UcbCommand.Caption = "a   alles löschen"
  UcbCommand.OnAction = "alles_loeschen"

  Set UcbCommand = _
  UMenu.Controls.Add(Type:=msoControlButton)
  UcbCommand.Caption = "b   alles, außer Pfad löschen"
  UcbCommand.OnAction = "Teil_loeschen"

  Set UcbCommand = _
  UMenu.Controls.Add(Type:=msoControlButton)
  UcbCommand.Caption = "c   alles löschen, Pfad manuell eingeben, Dateinamen auslesen"
  UcbCommand.OnAction = "Extra"

  Set UcbCommand = _
  UMenu.Controls.Add(Type:=msoControlButton)
  UcbCommand.Caption = "c   alles löschen, Pfad per Dialog einlesen, Dateinamen auslesen"
  UcbCommand.OnAction = "Extra2"

  Set UMenu = _
  cbSpecialMenu.Controls.Add(Type:=msoControlPopup)
  UMenu.Caption = "&9   Spezial"
  UMenu.BeginGroup = True

  Set UcbCommand = _
  UMenu.Controls.Add(Type:=msoControlButton)
  UcbCommand.Caption = "a...von Nr - Int - Tit nach Nr Tit - Int"
  UcbCommand.OnAction = "Nutzerdefiniert"

  Set UcbCommand = _
  UMenu.Controls.Add(Type:=msoControlButton)
  UcbCommand.Caption = "b...von Nr - Tit - Int nach Nr Tit - Int"
  UcbCommand.OnAction = "Nutzerdefiniert_2"

  Application.Caption = "Excel-Tuning by HS"
'  Windows(1).Caption = ActiveWorkbook.Name

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim cbSpecialMenu As CommandBarControl

  On Error Resume Next
  Set cbSpecialMenu = _
  Application.CommandBars("Worksheet Menu " & _
  "Bar").Controls("MP3-Menü-1")
  cbSpecialMenu.Delete

  Application.Caption = ""

'  Windows(1).Caption = ActiveWorkbook.Name

'  Set cbSpecialMenu = _
'  Application.CommandBars("Worksheet Menu " & _
'  "Bar").Controls("MP3-Menü-1")
'  cbSpecialMenu.Delete

  Set cbSpecialMenu = Nothing
  Set cbCommand = Nothing
  Set UMenu = Nothing
  Set UcbCommand = Nothing
End Sub

Private Sub Workbook_Deactivate()
  On Error Resume Next
  Application.CommandBars("Worksheet Menu " & _
  "Bar").Controls("MP3-Menü-1").Visible = False

  Application.Caption = ""
'  Windows(1).Caption = ActiveWorkbook.Name
End Sub

Private Sub Workbook_Activate()
  On Error Resume Next
  Application.CommandBars("Worksheet Menu " & _
  "Bar").Controls("MP3-Menü-1").Visible = True

  Application.Caption = "Excel-Tuning by HS"
'  Windows(1).Caption = ActiveWorkbook.Name
End Sub