25.01.2016, 13:56
Hallo liebe Excel Experten,
ich möchte mittels VBA Code in der Lage sein, IDV2 Tags in Audio Dateien reinzuschreiben. Bei meiner Recherche bin ich auf folgenden voll funktionierden Code für das Auslesen eines IDV2 Tags aus Audiodateien gestoßen:
Um jetzt nicht unendliche Stunden vor dem Computer sitzen zu müssen, bräuchte ich nun euren Rat und eure Expertise.Wie sieht der entsprechende Code zum Schreiben eines IDV2 Tags für Audiodateien aus. Anmerkung
noch von mir, der IDV2 Tag hat gegenüber dem IDV1 Tag den Vorteil, dass es defacto so gut wie keine Beschränkungen in der Textlänge der einzelnen Tags geben soll.
Vielen Dank für eure Hilfe und Mühen schon mal im voraus.
ich möchte mittels VBA Code in der Lage sein, IDV2 Tags in Audio Dateien reinzuschreiben. Bei meiner Recherche bin ich auf folgenden voll funktionierden Code für das Auslesen eines IDV2 Tags aus Audiodateien gestoßen:
Code:
'Quelle:
'http://www.mrexcel.com/forum/excel-questions/52719-read-mp3-id3v2-tags.html
'IDV2 Tags aus Audiodateien lesen
Option Explicit
Public Type ID3v2
sTitle As String
sArtist As String
sAlbum As String
sComment As String
sYear As String
sGenre As String
sComposer As String
sURL As String
sOrgArtist As String
sCopyright As String
sEncodeBy As String
sTrack As String
sMedium As String
sLen As String
End Type
' Prüfen, ob eine MP3-Datei über ID3v2-Infos verfügt
' Rückgabewert: Länge des ID3v2-Tags
Public Function MP3_ID3v2Exists( _
ByVal sFile As String) As Long
Dim sText As String
Dim sBin As String
Dim sID3 As String * 3
Dim i As Integer
Dim z As Integer
Dim b(4) As Byte
Dim F As Integer
Dim nID3v2Size As Long
' Datei öffnen
On Error GoTo ErrHandler
F = FreeFile
Open sFile For Binary As #F
Get #F, 1, sID3
If sID3 <> "ID3" Then
MP3_ID3v2Exists = 0
Close #F
Exit Function
End If
' Größe des ID3v2-Tags ermitteln
Get #F, 7, b(4)
Get #F, 8, b(3)
Get #F, 9, b(2)
Get #F, 10, b(1)
sBin = ""
For z = 2 To 4
For i = 0 To 6
sBin = sBin & CStr(Abs(b(z) And (2 ^ i)))
Next i
Next z
nID3v2Size = 0
For i = 7 To 27
nID3v2Size = nID3v2Size + ((2 ^ i) * Val(Mid(sBin, i - 6, 1)))
Next i
nID3v2Size = nID3v2Size + b(1) + 10
MP3_ID3v2Exists = nID3v2Size
Close #F
Exit Function
ErrHandler:
If F > 0 Then Close #F
MP3_ID3v2Exists = 0
End Function
' ID3v2-Infos auslesen
Public Function MP3_ReadID3v2Tag( _
ByVal sFile As String, _
ByVal nID3v2Size As Long) As ID3v2
Dim nPos As Long
Dim sFrameType As String * 4
Dim sText As String
Dim sBin As String
Dim sID3 As String * 3
Dim i As Integer
Dim z As Integer
Dim b(4) As Byte
Dim F As Integer
Dim nSize As Long
On Error GoTo ErrHandler
' Datei öffnen
F = FreeFile
Open sFile For Binary As #F
' Start-Position
nPos = 11
' Liest den Framtyp so lange aus bis es nichts
' mehr zum lesen gibt
Do While nPos < nID3v2Size
' der eingelesene Framtyp
Get #F, nPos, sFrameType
If InStr(sFrameType, Chr$(0)) > 0 Then
' Fertig nichts mehr zum lesen
Close #F
Exit Do
End If
nPos = nPos + 4
Get #F, nPos, b(4) ' FrameTyp Größe
Get #F, nPos + 1, b(3) ' FrameTyp Größe
Get #F, nPos + 2, b(2) ' FrameTyp Größe
Get #F, nPos + 3, b(1) ' FrameTyp Größe
nPos = nPos + 5
sBin = ""
For z = 2 To 4
For i = 0 To 7 Step 1
sBin = sBin & CStr(Abs(b(z) And (2 ^ i)))
Next i
Next z
' Framtyp-Größe ausrechnen
nSize = 0
For i = 8 To 30
nSize = nSize + ((2 ^ i) * Val(Mid$(sBin, i - 7, 1)))
Next i
nSize = nSize + b(1)
' ID3v2-Info
sText = String$(nSize, vbNullChar)
nPos = nPos + 1
Get #F, nPos, sText
sText = TrimNullChar(sText)
With MP3_ReadID3v2Tag
Select Case sFrameType
Case "TMED"
.sMedium = sText
Case "TLEN"
.sLen = sText
Case "TRCK"
.sTrack = sText
Case "TENC"
.sEncodeBy = sText
Case "WXXX"
.sURL = sText
Case "TCOP"
.sCopyright = sText
Case "TOPE"
.sOrgArtist = sText
Case "TCOM"
.sComposer = sText
Case "COMM"
.sComment = sText
Case "TCON"
sText = Replace(sText, "(", "")
sText = Replace(sText, ")", "")
.sGenre = sText
Case "TYER"
.sYear = sText
Case "TALB"
.sAlbum = sText
Case "TPE1"
.sArtist = sText
Case "TIT2"
.sTitle = sText
End Select
nPos = nPos + nSize
End With
Loop
ErrHandler:
Close #F
End Function
Private Function TrimNullChar( _
ByVal sString As String) As String
sString = Replace(sString, vbNullChar, vbNullString)
TrimNullChar = Trim$(sString)
End Function
Sub test()
Dim sFile As String, uID3v2 As ID3v2, nSize As Long
' MP3 path and name
sFile = "C:\Audio\IDV2_Testdatei.mp3"
' MP3 V2 Tag info Exist?
nSize = MP3_ID3v2Exists(sFile)
If nSize > 0 Then
uID3v2 = MP3_ReadID3v2Tag(sFile, nSize)
With uID3v2
MsgBox "Title: " & .sTitle & vbCrLf & _
"Artist: " & .sArtist & vbCrLf & _
"Album: " & .sAlbum & vbCrLf & _
"Track: " & .sTrack & vbCrLf & _
"Length: " & .sLen & vbCrLf & _
"Medium: " & .sMedium & vbCrLf & _
"Genre: " & .sGenre
End With
Else
MsgBox "No ID3v2 tag info available"
End If
End Subnoch von mir, der IDV2 Tag hat gegenüber dem IDV1 Tag den Vorteil, dass es defacto so gut wie keine Beschränkungen in der Textlänge der einzelnen Tags geben soll.
Vielen Dank für eure Hilfe und Mühen schon mal im voraus.
Ich hab da auch noch was vor, allerdings nicht so schnell, kann noch Monate daueren.