AW: MP3 mit Excel abspielen/verwalten
17.05.2006 18:14:55
Lars Jungclaus
Hallo K. Rola,
ich bekomme die Datei nicht hochgeladen, anbei der Code:
Sub CreateFileList()
Dim wks As Worksheet
Dim iCounter As Integer, iCount As Integer
Dim sSource As String, sTxt As String
Application.ScreenUpdating = False
Rows(5).Hidden = False
sSource = Range("Source").Value
If Len(sSource) = 1 Then
sSource = sSource & ":\"
End If
Workbooks.Add 1
Set wks = ActiveSheet
ThisWorkbook.Activate
Application.ScreenUpdating = True
wks.Columns("A:B").NumberFormat = "@"
wks.Columns("C").NumberFormat = "#,##0"
wks.Range("A1").Value = "LfdNr."
wks.Range("B1").Value = "Dateiname"
wks.Range("C1").Value = "Dateigröße"
wks.Range("D1").Value = "Dateidatum"
With wks.Range("A1:D1")
.Font.Bold = True
.Interior.ColorIndex = 1
.Font.ColorIndex = 2
End With
With Application.FileSearch
.NewSearch
.LookIn = sSource
.Filename = "*.mp3*"
.SearchSubFolders = True
.Execute
iCount = .FoundFiles.Count
For iCounter = 1 To iCount
If iCounter Mod 100 = 0 Then Range("D5").Value = _
"Bearbeite Datei Nr. " & iCounter & "..."
wks.Cells(iCounter + 1, 2).Value = .FoundFiles(iCounter)
wks.Hyperlinks.Add _
anchor:=wks.Cells(iCounter + 1, 2), _
Address:=.FoundFiles(iCounter)
wks.Cells(iCounter + 1, 3).Value = FileLen(.FoundFiles(iCounter))
wks.Cells(iCounter + 1, 4).Value = FileDateTime(.FoundFiles(iCounter))
Next iCounter
End With
Application.ScreenUpdating = False
wks.Range("A1").CurrentRegion.Sort _
key1:=wks.Range("B2"), order1:=xlAscending, header:=xlYes
For iCounter = 2 To iCount + 1
wks.Cells(iCounter, 1).Value = Format(iCounter - 1, "0000")
Next iCounter
Rows(5).Hidden = True
wks.Columns.AutoFit
' wks.Columns("E:IV").Hidden = True
' wks.Rows(iCounter & ":" & Rows.Count).Hidden = True
wks.Name = "Dateiliste"
' Windows(wks.Parent.Name).DisplayHeadings = False
wks.Parent.Activate
End Sub
Ein Feld, bei mir Celle F1 muss mit dem Bereichsnamen source versehen sein und das Laufwerk wie c muss drin stehen. Dann liest er alle und erstellt Hyperlinks. Aber es läßt sich immer nur ein Hyperling öffnen.
Gruß Lars