hallo,
lange Rede, kurzer Sinn: wie bekomme ich die komple
tten Playlisten aus iTunes auf einen USB-Stick?
danke für die Hilfe,
M.
Mikele
hatte das gleiche Problem. Nach langer erfolgloser Suche im Internet habe ich mir ein Excel Makro geschrieben.
Zunächst musst Du die Playlisten mit iTunes exportieren und in ein Verzeichnis auf dem Stick legen
Das Programm ließt dann die Playlisten aus und kopiert die referenzierten MP3 Dateien auf den Stick
Hierbei wird auch die Verzeichnisstruktur mit aufgebaut. Sollten MP3s mehrfach vorkommen, so wird die Datei nur einmal kopiert.
Das Programm baut auch die Playlisten wieder neu auf, sodass diese im BMW abspielbar sind.
Das Programm protokolliert im Excelsheet ob Dateien kopiert wurden. (Das Programm ist ab Excel 2007 nutzbar)
Ich habe auf diesem Weg 78 GB an Playlisten auf einen Stick geladen. (Der BMW benötigt etwas Zeit um die Daten zu indizieren, anschließend funktioniert alles perfekt)
Vor der Nutzung musst Du im Quellcode die Pfadangaben für Deine Zwecke anpassen, da ich diese hard codiert habe.
Quellcode: (ADO Verweis muss aktiv sein)
Sub build_path(target)
'Unterprogramm zur rekursiven Erstellung von Dateipfaden
Dim fso As FileSystemObject
Dim path
Set fso = CreateObject("Scripting.FileSystemObject")
path = Left(target, InStrRev(target, "\") - 1)
path1 = Left(target, InStrRev(target, "\") - 1)
If Not fso.FolderExists(path) Then
If Not fso.FolderExists(path1) Then
build_path path1
End If
fso.CreateFolder path
End If
End Sub
Sub m3u_copy_UTF8()
Const stick = "H:\"
Const itunes = "\\JAEGERHOME\all_media\Music\"
Dim fso As FileSystemObject
Dim f As ADODB.Stream
Dim f2 As ADODB.Stream
Dim d As Folder
Dim fi As File
Dim s, source, target, i, j, k, playlistname
Dim suf As String
i = 0
j = 0
k = 0
ActiveSheet.UsedRange.Clear
Set fso = CreateObject("Scripting.FileSystemObject")
'Lesen der Dateien aus dem Verzeichnis auf dem Stick in welches die Playlist abgelegt wurden
'muss ggf angepasst werden ( bei mit ist H: der USB-Stick)
Set d = fso.GetFolder("H:\_PL\")
For Each fi In d.Files
If Right(fi.Name, 4) = ".m3u" Then
ActiveSheet.Cells(4, 1) = "Working on: " & fi.Name
Set f = New ADODB.Stream
Set f2 = New ADODB.Stream
f.Charset = "UTF-8"
f.Open
f.LoadFromFile fi.path
f2.Charset = "UTF-8"
f2.Open
'f2.SaveToFile "H:\" & fi.Name
While Not f.EOS
s = f.ReadText(adReadLine)
If Left(LTrim(s), 1) = "#" Then
f2.WriteText s, adWriteLine
'Kommentarzeilen in der *.m3u werden 1:1 übertragen
Else
' Wenn iTunes Dateien auf einem Netzwekshare liegen muss dieser auf einem Laufwerksbuchstaben gemapped sein
' In der exprotireten m2u Datei wird dann der Netzwerkpfad ersetzt
source = Replace(s, "\\JAEGERHOME\all_media\", "S:\")
' Ersetzen des Root Pfads der Itunes Bibliothek gegen den neuen RootPfad auf dem Stick
target = Replace(s, itunes, stick) '
wr = Replace(s, itunes, ".\")
'Schreiben der neuen Refernz in die konvertierte Playlist
f2.WriteText wr, adWriteLine
i = i + 1 'Einfacher Zähler
build_path target
If Not fso.FileExists(target) Then
If fso.FileExists(source) Then
fso.CopyFile source, target, False
ActiveSheet.Cells(i + 5, 1) = "Copied: " & target
j = j + 1
ActiveSheet.Cells(5, 1) = "Last Copied: " & target
Else
ActiveSheet.Cells(i + 5, 1) = "Source not found: " & source
k = k + 1
End If
Else
ActiveSheet.Cells(i + 1, 1) = "Target Exists: " & target
End If
End If
ActiveSheet.Cells(1, 1) = "Einträge bearbeitet: " & i
ActiveSheet.Cells(2, 1) = "MP3 Files kopiert: " & j
ActiveSheet.Cells(3, 1) = "MP3 Quellfiles nicht gefunden: " & k
Wend
f.Close
playlistname = fi.Name
n = 0
suf = ""
While fso.FileExists(stick & suf & playlistname)
n = n + 1
suf = n
Wend
f2.SaveToFile stick & suf & playlistname
f2.Close
End If
Next
End Sub