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

Function ID_TAG_auslesen(Tagname As String, Ueberschrift As String)
' Autor: Hubert Scheidgen 07.2007
Dim b As Byte, Zeile As Byte, Spalte As Byte, i As Long
Dim TagInhalt As String
Dim Pfad As String, Datei As String, TN As String
Dim Knz As String * 4 'Tagheader
Dim ID3Knz As String * 3 'die ersten 3 Bytes eines ID3v2 Containers
Dim Leseposition As Long
Dim ID3Laenge As String * 4 'ID3v2 Länge im ASCII Format
Dim lngID3Laenge As Long 'ID3v2 Grösse in Bytes (=Anzahl Bytes in Dezimal-Form)
'Dim Beite(1 To 4) As Long
Dim Ende As Long
'Dim Spaltennummer As Integer

On Error GoTo Fehler

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

Spalte = ActiveCell.Cells.Column

Pfad = Worksheets(3).Range("A1").Value & "\"
'Spalte = Spaltennummer
Zeile = 2
Tagname = UCase(Tagname)


Do Until IsEmpty(Worksheets(2).Range("A" & Zeile)) = True
  Datei = Pfad & Worksheets(2).Range("A" & Zeile).Value

  Open Datei For Binary Access Read As #1
  Get #1, 1, ID3Knz

    If ID3Knz = "ID3" Then
      'ID3v2 Containerlänge feststellen
      Get #1, 7, ID3Laenge

      'Beite(1) = Asc(Left$(ID3Laenge, 1))
      'Beite(2) = Asc(Mid$(ID3Laenge, 2, 1))
      'Beite(3) = Asc(Mid$(ID3Laenge, 3, 1))
      'Beite(4) = Asc(Mid$(ID3Laenge, 4, 1))
      'lngID3Laenge = (&H200000 * Beite(1)) + _
      '(&H4000 * Beite(2)) + (&H80 * Beite(3)) + Beite(4)

      lngID3Laenge = CLng(&H200000) * Asc(Left$(ID3Laenge, 1)) + _
      CLng(&H4000) * Asc(Mid$(ID3Laenge, 2, 1)) + _
      CLng(&H80) * Asc(Mid$(ID3Laenge, 3, 1)) + _
      Asc(Mid$(ID3Laenge, 4, 1))

      Leseposition = 11   '

      Do Until Leseposition > lngID3Laenge
          'FrmLng = 0
          Ende = 0
          Get #1, Leseposition, Knz

          If UCase(Knz) = Tagname Then
             Ende = Framegroesse(Leseposition) - 1
             Seek 1, Leseposition + 4 + 7
             b = "0"
             For i = 1 To Ende
               Get #1, , b
               TagInhalt = TagInhalt & Chr(b)
             Next i

             'Close #1

             If Len(TagInhalt) = 1 And UCase(Tagname) = "TRCK" Then
               TagInhalt = "0" & TagInhalt
             End If

             Worksheets("Tabelle1").Cells(Zeile, Spalte).Value = Trim(TagInhalt)
             'Worksheets("Tabelle1").Range("B" & Zeile).Value = lngID3Laenge
             TagInhalt = Empty
             Exit Do

          Else 'auslesen der Framegrösse
             Leseposition = Leseposition + 10 + Framegroesse(Leseposition)
          End If
      Loop

      Close #1

    Else
      Close #1
    End If

  'Close #1
  TN = Empty
  Zeile = Zeile + 1

Loop

Worksheets("Tabelle1").Cells(1, Spalte).Value = Ueberschrift
Worksheets(1).Range("A:D").Columns.AutoFit
MsgBox ("Auslesen des ID3v2 Tags beendet")

Fehler:
'Close #1

End Function

Function Framegroesse(Leseposition)
Dim i As Integer
Dim b As Byte
Dim FrmLng As String * 4 'Framelänge im ASCII Format
Dim lngFrmLng As Long 'Framegrösse in Bytes (=Anzahl Bytes in Dezimal-Form)
Dim Beite(1 To 4) As Long

' For i = 0 To 3
' Get #1, Leseposition + 4 + i, b
' Next i
  Get #1, Leseposition + 4, FrmLng

    Beite(1) = Asc(Left$(FrmLng, 1))
    Beite(2) = Asc(Mid$(FrmLng, 2, 1))
    Beite(3) = Asc(Mid$(FrmLng, 3, 1))
    Beite(4) = Asc(Mid$(FrmLng, 4, 1))

  lngFrmLng = &H10000 * Beite(1) + _
  &H1000 * Beite(2) + &H100 * Beite(3) + Beite(4)

  'Leseposition = Leseposition + 10 + lngFrmLng
  Framegroesse = lngFrmLng
End Function

Function Teil_auslesen(Art As String, ES As Byte, TN As Boolean)
Dim i As Byte
Dim TZ As String 'Trennzeichen
Dim Text As String 'Dateiname oder Teil daraus
Dim DE As String
'Dim haedertext As String

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

On Error GoTo weiter1
i = 2

Do Until IsEmpty(Worksheets(2).Range("A" & i)) = True
  Text = Worksheets(2).Range("A" & i).Value
  DE = LCase(Right(Text, 3)) 'Dateiendung
  Worksheets(1).Cells(i, 4).Value = DE 'Dateiendung

    Select Case Art
      Case "1"
        Text = Trim(Left(Text, InStr(Text, TZ) - 1))
      Case "2;3"
        Text = Trim(Right(Text, Len(Text) - (InStr(Text, TZ))))
        Text = Trim(Left(Text, InStr(Text, TZ) - 1))
      Case "3;3"
        Text = Trim(Right(Text, Len(Text) - (InStr(Text, TZ))))
        Text = Trim(Right(Text, Len(Text) - (InStr(Text, TZ))))
        Text = Trim(Left(Text, InStr(Text, ".") - 1))
      Case "2;2"
        Text = Trim(Right(Text, Len(Text) - (InStr(Text, TZ))))
        Text = Trim(Left(Text, InStr(Text, ".") - 1))
    End Select

    If TN = True And Len(Text) = 1 Then
        Text = "0" & Text
    End If

  Worksheets(1).Cells(i, ES).Value = Text


weiter1:
  Text = Empty
  i = i + 1

Loop

i = Empty
ES = Empty
Art = Empty
TN = False

End Function

Function Headertext(Anweisung As String)
Dim Spaltenkopf(1 To 3)
'Dim i As Byte


    Spaltenkopf(1) = "TrackNr."
    Spaltenkopf(2) = "Interpret"
    Spaltenkopf(3) = "Titel"

    Worksheets(1).Cells(1, 1).Value = Spaltenkopf(Left(Anweisung, 1) * 1)
    Worksheets(1).Cells(1, 2).Value = Spaltenkopf(Mid(Anweisung, 2, 1) * 1)
    Worksheets(1).Cells(1, 3).Value = Spaltenkopf(Mid(Anweisung, 3, 1) * 1)
    Worksheets(1).Cells(1, 4).Value = "Endung"
    Worksheets(1).Range("A:D").Columns.AutoFit

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