Private Sub SearchFiles(strFolder As String, strFileName As String)
Dim objFolder As Object, objFile As Object, Txt As String
Dim objFSO As Object, objFolderItem As Object, y As Long
Set objFSO = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
On Error GoTo Fehler
For Each objFile In objFSO.getfolder(strFolder).Files
'** diese Set Anweisung klappt nicht !!
' Set objFolder = objShell.Namespace(CVar(subfld.Path)) Nepumuk
Set objFolderItem = objFSO.ParseName(objFolder)
If objFile.Name Like strFileName Then
ReDim Preserve strList(0 To 6, lngCount)
strList(1, lngCount) = objFile.Name
strList(3, lngCount) = objFile.Size
strList(4, lngCount) = objFile.datelastaccessed
strList(2, lngCount) = Mid(objFile, InStrRev(objFile, ".") + 1)
Txt = LCase(strList(2, lngCount))
If Left(Txt, 1) = "m" Or Left(Txt, 2) = "wm" Then
' strList(5, lngCount) = objFSO.GetDetailsOf(objFolderItem, 21) '31 Bildformat
' strList(6, lngCount) = objFSO.GetDetailsOf(objFolderItem, 22) '31 Bildformat
strList(5, lngCount) = "Zeit"
strList(6, lngCount) = "Kb/s"
End If
lngCount = lngCount + 1: f = f + 1
End If
Next
no: '1. Ordner auflisten
If o = 0 Then
On Error Resume Next
strList(0, 0) = lngCount & " Files"
strList(1, 0) = strFolder 'Ordnername
strList(3, 0) = objFSO.getfolder(strFolder).Size
strList(4, 0) = objFSO.getfolder(strFolder).datecreated
strOrd(0, 0) = objFSO.getfolder(strFolder).Files.Count
strOrd(1, 0) = strFolder
End If
For Each objFolder In objFSO.getfolder(strFolder).subfolders
If InStr(objFolder, "RECYCLE") Then GoTo nx
If InStr(objFolder, "System Volume") Then GoTo nx
'Application.StatusBar = lngCount & " " & objFolder.Name
ReDim Preserve strOrd(0 To 2, lngOrd + 1)
strOrd(0, lngOrd) = objFSO.getfolder(objFolder).Files.Count
strOrd(1, lngOrd) = objFolder: lngOrd = lngOrd + 1
ReDim Preserve strList(0 To 6, lngCount)
strList(0, lngCount) = Empty
lngCount = lngCount + 1
ReDim Preserve strList(0 To 6, lngCount)
strList(1, lngCount) = objFolder.Name
strList(3, lngCount) = objFolder.Size
strList(4, lngCount) = objFolder.datecreated
strList(0, lngCount) = objFolder.Files.Count & " Files"
lngCount = lngCount + 1: o = o + 1
SearchFiles strFolder & "\" & objFolder.Name, strFileName
nx: [a1].Value = f: [a2].Value = o
Next
Application.StatusBar = Empty
Exit Sub
Fehler: 'Fehlermeldung ausgeben
fe = fe + 1: [c3] = fe & " Array Fehler": Resume Next
End Sub