AW: Daten sortieren
01.06.2012 14:17:34
Frank
Hallo Rudi,
danke für die schnelle Antwort. Das angefügte Bild ist ja nur exemplarisch zu verstehen. Es _
sind weit aus mehr Ordner, die alle MP3's enthalten. Und wenn ich im Nachgang das sortiere, dann habe ich als erstes bspw. 10mal Titel 1 stehen usw. Bei dem "
Private Sub SearchFiles" kommt es dazu dass die Dateien nicht in der richtigen Reihenfolge _
eingelesen werden. Ich weiß aber nicht wieso. Könnte mir bitte jemand helfen.
Vielen Dank und viele Grüße,
Frank
So sieht der Code aus:
Option Explicit
Private strList() As String
Private strDir() As String
Private strDir1() As String
Private strDir2() As String
Private strDir3() As String
Private lngCount As Long
Public Sub mp3read()
Dim lngTMP As Long
Dim strTMP As String
lngCount = 0
Application.ScreenUpdating = False
strTMP = GetFolder()
If strTMP = "" Or Left(strTMP, 1) = ":" Then Exit Sub
SearchFiles strTMP, "*.*"
If lngCount = 0 Then
MsgBox "No file found"
Exit Sub
End If
With ThisWorkbook.Worksheets(1)
.Cells.Clear
.Range(.Cells(1, 1), Cells(lngCount, 1)) = _
WorksheetFunction.Transpose(strList)
End With
Call Aufteilen
Application.ScreenUpdating = True
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, Optional blnTMP As Boolean = _
True)
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)
strList(lngCount) = objFile.Path
lngCount = lngCount + 1
End If
Next
If blnTMP = True Then
For Each objFolder In objFSO.GetFolder(strFolder).SubFolders
SearchFiles strFolder & "\" & objFolder.Name, strFileName
Next objFolder
End If
End Sub
Private Sub Aufteilen()
Dim lngRow As Long
For lngRow = 1 To UBound(strList) + 1
strDir = Split(Cells(lngRow, 1).Value, "\")
strDir1 = Split(strDir(4), "-")
strDir2 = Split(strDir1(0), ".")
strDir3 = Split(strDir1(1), ".")
Cells(lngRow, 1).Value = strDir(2)
Cells(lngRow, 2).Value = strDir(3)
Cells(lngRow, 3).Value = strDir2(0)
Cells(lngRow, 4).Value = strDir2(1)
Cells(lngRow, 5).Value = strDir3(0)
Next lngRow
End Sub