share it if you like it
share it if you like it
share it if you like it
Die Excel Wühlkiste

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 

Option Explicit

Sub umwandeln_in_GK_Schreibung()
' Autor: Hubert Scheidgen 07.2007
Dim Zelle As Range
Dim x As String
Dim i, TL As Integer 'Zähler, Textlänge

For Each Zelle In Selection
  TL = Len(Zelle)
  x = Zelle.Value
  x = UCase(Mid(x, 1, 1)) & Mid(x, 2, Len(x) - 1)

  For i = 2 To TL
    If Mid(x, i - 1, 1) = " " Then
    x = Left(x, i - 1) & UCase(Mid(x, i, 1)) & Mid(x, i + 1, TL - i)
    Else
    x = Left(x, i - 1) & LCase(Mid(x, i, 1)) & Mid(x, i + 1, TL - i)
    End If
  Next i

  Zelle.Value = x
Next Zelle
End Sub

Sub DNE_ETZ_true()
'Dateinamen erstellen
Dim erstesTrennzeichen As Boolean
erstesTrennzeichen = True
Call Dateinamen_erstellen(erstesTrennzeichen)
End Sub

Sub DNE_ETZ_false()
'Dateinamen erstellen
Dim erstesTrennzeichen As Boolean
erstesTrennzeichen = False
Call Dateinamen_erstellen(erstesTrennzeichen)
End Sub

Sub Dateinamen_erstellen(ETZ)
'Dim ETZ As Boolean 'erstesTrennzeichen
Dim DN As String 'Dateinahme
Dim Teil(1 To 3) As String 'Tracknummer, Interpret, Titel
Dim TZ As String 'Trennzeichen
Dim TZ1 As String 'Trennzeichen
Dim i As Byte ' Zähler
Dim DE As String 'Dateiendung

'Debug.Print ATZ
TZ = Worksheets(3).Range("B2").Value
TZ1 = " " & TZ & " "

i = 2

With Worksheets(1)
  Do Until IsEmpty(.Range("A" & i)) = True
    DE = .Range("D" & i).Value

    Teil(1) = .Range("A" & i).Value
    Teil(2) = .Range("B" & i).Value
    Teil(3) = .Range("C" & i).Value
    DE = "." & .Range("D" & i).Value

    If ETZ = True Then
      DN = Teil(1) & TZ1 & Teil(2) & TZ1 & Teil(3) & DE
        With Worksheets(2)
          If Len(.Range("A" & i)) <> Len(DN) Then
            .Range("E" & i) = "!!!"
          Else
            .Range("E" & i) = "ok"
          End If
        End With

    ElseIf ETZ = False Then
      DN = Teil(1) & " " & Teil(2) & TZ1 & Teil(3) & DE

      With Worksheets(2)
        If Len(.Range("A" & i)) <> Len(DN) + 2 Then
          .Range("E" & i) = "!!!"
        Else
          .Range("E" & i) = "ok"
        End If
      End With

    End If

    Worksheets(2).Range("B" & i).Value = DN
    i = i + 1
  Loop
End With

i = Empty
DE = Empty
DN = Empty

Call Trennzeichen_zaehlen_1("B", "D")

Worksheets(2).Activate
Range("A1").Select

End Sub

Sub Dateinamen_auslesen()
'Dateinamen in einem bestimmten Verzeichnis auflisten
'Die Angabe des Verzeichnises erfolgt in DOS Konvention
'Eingefügt werden die Daten ab der aktiven Zelle

  Dim Dateiname, Pfad, DE As String, i As Integer
  Pfad = Worksheets(3).Range("A1").Value

  If Pfad = Empty Then
    MsgBox ("zuerst Pfad in Tabelle 3 A1 eintragen")
    Exit Sub
  End If

  Dateiname = Dir$(Pfad & "\*.*") 'Hier Verzeichnis und Datei angeben
  i = 2

  Do While Dateiname <> ""
    Worksheets(2).Range("A" & i) = Dateiname
    i = i + 1
    Dateiname = Dir$()
  Loop

  i = Empty

i = 2

With Worksheets(2)
    Do Until IsEmpty(.Range("A" & i)) = True
    DE = Right(.Range("A" & i), 3)

    If DE <> "mp3" And DE <> "wav" And DE <> "mid" _
        And DE <> "ogg" Then
        .Range("A" & i).EntireRow.Delete
        i = i - 1
    End If


        i = i + 1
    Loop
End With

Worksheets(2).Activate
Range("A1").Select

Call Trennzeichen_zaehlen_1("A", "C")

End Sub

Sub Dateien_umbenennen()
' oder: Speichern der neuen Dateinamen mit der Methode "Name DateinameAlt As DateinameNeu"
Dim DA 'Dateiname alt
Dim DN 'Dateiname neu
Dim i As Byte
Dim Pfad As String

If Worksheets(3).Range("A1").Value = "" Then
    MsgBox ("zuerst Pfad in Tabelle 3 A1 eintragen")
    Exit Sub
End If

Pfad = Worksheets(3).Range("A1").Value

i = 2

With Worksheets(2)
    Do Until IsEmpty(.Range("A" & i)) = True
        DA = .Range("A" & i).Value
        DN = .Range("B" & i).Value
        On Error Resume Next
        Name Pfad & "\" & DA As Pfad & "\" & DN
        i = i + 1
    Loop
End With

i = Empty

End Sub

Sub Drei_aa()
' von Interpret - Titel - Tracknummer
' nach Tracknummer - Interpret - Titel
Call Teil_auslesen("1", 2, False) 'Interpret auslesen
Call Teil_auslesen("2;3", 3, False) 'Titel auslesen
Call Teil_auslesen("3;3", 1, True) 'Tracknummer auslesen
Call Headertext("123")

Worksheets(1).Activate
Range("A1").Select
End Sub

Sub Drei_ba()
' von Interpret - Tracknummer - Titel
' nach Tracknummer - Interpret - Titel
Call Teil_auslesen("1", 2, False) 'Interpret auslesen
Call Teil_auslesen("2;3", 1, True) 'Tracknummer auslesen
Call Teil_auslesen("3;3", 3, False) 'Titel auslesen
Call Headertext("123")

Worksheets(1).Activate
Range("A1").Select
End Sub

Sub Drei_ca()
' von Tracknummer - Titel - Interpret
' nach Tracknummer - Interpret - Titel
Call Teil_auslesen("1", 1, True) 'Tracknummer
Call Teil_auslesen("2;3", 3, False) 'Titel auslesen
Call Teil_auslesen("3;3", 2, False) 'Interpret auslesen
Call Headertext("123")

Worksheets(1).Activate
Range("A1").Select
End Sub

Sub Drei_da()
' von Tracknummer - Interpret - Titel
' nach Interpret - Titel - Tracknummer
Call Teil_auslesen("1", 3, True) 'Tracknummer auslesen
Call Teil_auslesen("2;3", 1, False) 'Interpret auslesen
Call Teil_auslesen("3;3", 2, False) 'Titel auslesen
Call Headertext("231")

Worksheets(1).Activate
Range("A1").Select
End Sub

Sub Drei_db()
' von Tracknummer - Interpret - Titel
' nach Tracknummer - Titel - Interpret
Call Teil_auslesen("1", 1, True) 'Tracknummer auslesen
Call Teil_auslesen("2;3", 3, False) 'Interpret auslesen
Call Teil_auslesen("3;3", 2, False) 'Titel auslesen
Call Headertext("132")

Worksheets(1).Activate
Range("A1").Select
End Sub

Sub Drei_ea()
' von Interpret - Titel
' nach Tracknummer (manuell) - Interpret - Titel
Call Teil_auslesen("1", 2, False) 'Interpret auslesen
Call Teil_auslesen("2;2", 3, False) 'Titel auslesen
Call Headertext("123")

Worksheets(1).Activate
Range("A1").Select
End Sub

Sub Drei_fa()
' von Titel - Interpret
' nach Tracknummer (manuell) - Interpret - Titel
Call Teil_auslesen("1", 3, False) 'Interpret auslesen
Call Teil_auslesen("2;2", 2, False) 'Titel auslesen
Call Headertext("123")

Worksheets(1).Activate
Range("A1").Select
End Sub

Sub Pfad_angeben()
Dim Pfad As String
Pfad = InputBox("Pfad angeben", , Worksheets(3).Range("A1").Value)
Worksheets(3).Range("A1").Value = Pfad
End Sub

Sub Pfad_einlesen()
'Name und Pfad einer Datei einlesen
Dim varDatei As Variant

    'Startverzeichnis festlegen:
    'ChDrive "G:"                 'erst das Laufwerk voreinstellen (bes. im Netzwerk oder bei mehreren Festplatten)
    'ChDir "G:\My Shared Folder1" 'dann erst den Pfad vorbelegen

    varDatei = Application.GetOpenFilename _
       ("MP3-Dateien,*.mp3," & _
    "Alle Musik-Dateien,*.*", 1, "Eine Musikdatei anwählen")

    If varDatei = False Then
        MsgBox "Keine Datei angewählt."
        Exit Sub
    End If

    'weitere Programmausführung hier ausserhalb von If...End If
    'Debug.Print varDatei
    'Debug.Print Dir(varDatei)
    Worksheets(3).Range("A1").Value = Left(varDatei, Len(varDatei) - Len(Dir(varDatei)) - 1)
End Sub

Sub alles_loeschen()
Worksheets(1).Range("A1:G1000").ClearContents
Worksheets(2).Range("A2:G1000").ClearContents
Worksheets(3).Range("A1").ClearContents
End Sub

Sub Teil_loeschen()
'alles, außer Pfad löschen
Worksheets(1).Range("A1:G1000").ClearContents
Worksheets(2).Range("A2:G1000").ClearContents
End Sub

Sub Extra()
'alles löschen, Pfad holen, Dateinamen auslesen

Call Teil_loeschen
Call Pfad_angeben
Call Dateinamen_auslesen

End Sub

Sub Extra2()
'alles löschen, Pfad holen, Dateinamen auslesen

Call Teil_loeschen
Call Pfad_einlesen
Call Dateinamen_auslesen

End Sub

Sub Dateinamen_kopieren()
' zum manuellen bearbeiten des kompletten Dateinamens
Dim i As Byte

i = 2
Do Until IsEmpty(Worksheets(2).Range("A" & i)) = True
    Worksheets(2).Range("A" & i).Copy Destination:=Worksheets(2).Range("B" & i)
    i = i + 1
Loop
i = Empty
Call Trennzeichen_zaehlen_1("B", "D")
End Sub

Sub Dateinamen_kopieren_ohne_ETZ()
' zum manuellen bearbeiten des kompletten Dateinamens
Dim i As Byte
i = 2
With Worksheets(2)
Do Until IsEmpty(Worksheets(2).Range("A" & i)) = True
    .Range("B" & i).Value = Left(.Range("A" & i), 3) & Right(.Range("A" & i), Len(.Range("A" & i)) - 5)
    i = i + 1
Loop
End With
i = Empty
Call Trennzeichen_zaehlen_1("B", "D")
End Sub

Sub ETZ_loeschen()
' zum manuellen bearbeiten des kompletten Dateinamens
Dim i As Byte
i = 2
With Worksheets(2)
Do Until IsEmpty(Worksheets(2).Range("B" & i)) = True
    .Range("B" & i).Value = Left(.Range("B" & i), 3) & Right(.Range("B" & i), Len(.Range("B" & i)) - 5)
    i = i + 1
Loop
End With
i = Empty
Call Trennzeichen_zaehlen_1("B", "D")
End Sub

Sub Trennzeichen_zaehlen()
Call Trennzeichen_zaehlen_1("B", "D")
End Sub

Sub Trennzeichen_zaehlen_1(Lesespalte As String, Ausgabespalte As String)
'trennzeichen in den original Dateinamen lesen
Dim TZ As String 'Trennzeichen
Dim i, Anzahl_TZ As Byte
Dim Text As String

TZ = Worksheets(3).Range("B2").Value

With Worksheets(2)
i = 2
    Do Until IsEmpty(.Range(Lesespalte & i)) = True
        Text = .Range(Lesespalte & i).Value
        Anzahl_TZ = Len(Text) - Len(Replace(Text, TZ, ""))
        .Range(Ausgabespalte & i).Value = Anzahl_TZ
        Anzahl_TZ = 0
        i = i + 1
    Loop
End With
i = Empty
Text = Empty
TZ = Empty
End Sub

Sub ID_TAG_1_auslesen()
Call ID_TAG_auslesen("TRCK", "TrackNr.")
End Sub

Sub ID_TAG_2_auslesen()
Call ID_TAG_auslesen("TPE1", "Interpret")
End Sub

Sub ID_TAG_3_auslesen()
Call ID_TAG_auslesen("TIT2", "Titel")
End Sub

Sub ID_TAG_4_auslesen()
Dim i As Byte ' Zähler
Dim Spalte As Integer

If ActiveSheet.Index <> 1 Then
MsgBox ("falsches Arbeitsblatt ausgewählt")
    Exit Sub
    End If

Spalte = ActiveCell.Cells.Column

i = 2
With Worksheets(1)
    Do Until IsEmpty(.Range("A" & i)) = True
            .Cells(i, Spalte).Value = Right(Worksheets(2).Range("A" & i).Value, 3)
            i = i + 1
    Loop
End With

Worksheets(1).Cells(1, Spalte).Value = "Endung"
Worksheets(1).Range("A:D").Columns.AutoFit

i = Empty
End Sub
Die Excel Wühlkiste
Valid HTML 4.01 Strict
letzte Aktualisierung: 13.02.2009
Autor: Hubert Scheidgen / 04.02.2009
W3C CSS-Validierungsservice