Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1144to1148
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

str... wie weiter für ID3v1 oder ID3v2

str... wie weiter für ID3v1 oder ID3v2
Frank
Hallo
geht es wie ich mir das denke, den Code so zu modifizieren das auch MP3-Daten ( ID3v.. ) mit ausgegeben werden können, ausser wie im Code zu ersehen ist, nur Ordner und Dateiname z.b.:
Spalte A: C:\musik\Al Bano & Romina Power\ Spalte B: Al Bano - Angell ( & Romina Power ).mp3
Den hier abgebildeten Code habe ich nicht erstellt, benutze ihn nur.
Code:
Option Explicit
Private strList() As String
Private strDir() As String ' hier müsste doch schon die erste Änderung/Ergänzung
Private lngCount As Long ' Private strFilename() As String vorgenommen werden können?)

Public Sub Test_3()
Dim strTMP As String
lngCount = 0
strTMP = GetFolder()
If strTMP = "" Or Left(strTMP, 1) = ":" Then Exit Sub
SearchFiles strTMP, "*.*" 'adapt
If lngCount = 0 Then
MsgBox "No file found"
Exit Sub
End If
With ThisWorkbook.Worksheets(1)
.Cells.Clear
.Range(.Cells(1, 2), Cells(lngCount, 2)) = _
WorksheetFunction.Transpose(strList)
.Range(.Cells(1, 1), Cells(lngCount, 1)) = _
WorksheetFunction.Transpose(strDir)
End With
Call Make_Link
End Sub


Private Function GetFolder() As String
Dim varFolder As Variant
Dim objShell As Object
Dim strPath As String
Set objShell = CreateObject("Shell.Application")
Set varFolder = objShell.BrowseForFolder(0, "Folder", &H10, 17)
If varFolder Is Nothing Then
Set varFolder = Nothing
Set objShell = Nothing
Exit Function
End If
GetFolder = varFolder.Self.Path
Set varFolder = Nothing
Set objShell = Nothing
End Function
Private Sub SearchFiles(strFolder As String, strFileName As String)
Dim objFolder As Object
Dim objFile As Object
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objFile In objFSO.GetFolder(strFolder).Files
If objFile.Name Like strFileName Then
ReDim Preserve strList(lngCount)
ReDim Preserve strDir(lngCount)
strList(lngCount) = objFile.Name
strDir(lngCount) = strFolder & "\"
lngCount = lngCount + 1
End If
Next
For Each objFolder In objFSO.GetFolder(strFolder).Subfolders
SearchFiles strFolder & "\" & objFolder.Name, strFileName
Next
End Sub
Public Sub Make_Link()
Dim lngRow As Long
With ThisWorkbook.Worksheets(1)
lngRow = .Range("a" & .Rows.Count).End(xlUp).Row
For lngRow = 1 To lngRow
.Hyperlinks.Add Anchor:=.Cells(lngRow, 1), Address:=.Cells(lngRow, 1)
Next lngRow
End With
With ThisWorkbook.Worksheets(1)
lngRow = .Range("B" & .Rows.Count).End(xlUp).Row
For lngRow = 1 To lngRow
.Hyperlinks.Add Anchor:=.Cells(lngRow, 2), Address:=.Cells(lngRow, 1) & .Cells( _
lngRow, 2)
Next lngRow
End With
End Sub
Denke mir für Euch Spezialist's, bestimmt kein Thema,
wenn Sie/Er mir helfen kann/will, würde mich ein kurzer Text weiterbringen ( ' das ist der Txt ...... )
Für eure Hilfe will ich mich an der Stelle vorab bedanken
Gruß Frank, der Tüftler ( learning by doing )

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
ID3 Tags
23.03.2010 16:05:05
Rudi
Hallo,
vielleicht hilft das weiter:
Public Sub Dateieigenschaften()
'von K.Rola
Const STRFOLDER As String = "f:\mp3\" 'anpassen
Dim objShell As Object, objFolder As Object
Dim intIndex As Integer, intColumn As Integer, lngRow As Long
Dim varName, arrItems()
If Dir(STRFOLDER, 16) = "" Then
MsgBox "Der Ordner " & STRFOLDER & " wurde nicht gefunden!", 64, "Hinweis"
Exit Sub
End If
Application.ScreenUpdating = False
tbListe.Cells.Clear
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(STRFOLDER)
intColumn = 1
ReDim arrItems(1 To 201, 1 To 1)
For intIndex = 0 To 200
arrItems(intColumn + intIndex, 1) = _
IIf(objFolder.getdetailsof(varName, intIndex) = "", "x", _
objFolder.getdetailsof(varName, intIndex))
Next
Rows(1).Font.Bold = True
lngRow = 2
For Each varName In objFolder.Items
ReDim Preserve arrItems(1 To 201, 1 To lngRow)
For intIndex = 0 To 200
arrItems(intColumn + intIndex, lngRow) = objFolder.getdetailsof(varName, intIndex)
Next
lngRow = lngRow + 1
Next
With tbListe
.Cells(1, 1).Resize(lngRow - 1, 201) = WorksheetFunction.Transpose(arrItems)
For lngRow = .Cells(1, .Columns.Count).End(xlToLeft).Column To 1 Step -1
If Application.CountA(.Columns(lngRow)) = 1 Then .Columns(lngRow).Delete
Next
.Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub

Gruß
Rudi
Anzeige
ID3 Tags auslesen ohne Ergebnis
23.03.2010 18:41:43
Frank
Hallo, irgendwie schnallt der Kopf auf der anderen Seite nicht mehr viel, vor lauter Zahlen und Wirrwarr
Hier die Fehlermeldung von dem Beispiel welches mir hier angeboten wurde.
Debugger angehalten bei: tbListe.Cells.Clear
Laufzeitfehler'424' Objekt erforderlich
Wie und was wo passiert ist mir jetzt ein Rätsel
Habe den unteren angepasst, aber nichts passiert
Const STRFOLDER As String = "f:\mp3\" 'anpassen
Hier mal meine Exceldatei mit ich hoffe besseren Klärungsargumenten.
https://www.herber.de/bbs/user/68770.xlsm
Mag kann man da was machen und wenn ja, wie?
Danke der Mühen von Euch
Gruß Frank
Anzeige
für den Test
23.03.2010 23:10:55
Rudi
Hallo,
du brauchst ein Sheet mit dem Codenamen tbListe
Gruß
Rudi
AW: für den Test
24.03.2010 16:56:08
Frank
Hallo
"Rudi" schrieb
du brauchst ein Sheet mit dem Codenamen tbListe

hab'sch geschrieben/umbenannt Tabelle1 zu tbListe, trotzalledem tat sich nüscht.
Meine Bespielexceldatei kann dir eventuell da weiterhelfen wie gerne arbeiten/abrufen würde!
Nehme jeden Verbesserungsvorschlag dankend an!
Danke vorab an Dich/Euch.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige