Ordner und Dateien auslesen
12.07.2014 20:24:59
WalterK
den folgenden Code habe ich im Internet gefunden, ich benutze ihn um Verzeichnisse auszulesen.
Bei einigen Verzeichnissen oder Ordnern wie z.B. C: kommt der Laufzeitfehler 70: Zugriff verweigert.
Allerdings handelt es sich um meinen eigenen Homes-PC.
Was kann der Grund für diese Fehleranzeige sein? Bei anderen Verzeichnissen oder Ordnern funktioniert der Code.
Hier der Code den ich benutze:
Dim ws As Worksheet, blnFiles As Boolean, arrType
Sub Verzeichnisbaum()
Dim objBrowseDir As Object, arrNames(), i As Integer
arrNames = Array("Ordner", "Datei", "Ordnergröße (MBytes)", "Dateigröße (MBytes)", " _
Dateityp", "erstellt am", "geändert am", "letzter Zugriff am")
Set objBrowseDir = CreateObject("Shell.Application").BrowseForFolder(0, "Ordner auswählen", _
&H0, 17)
Application.ScreenUpdating = False
If Not objBrowseDir Is Nothing Then
Set ws = Worksheets.Add(after:=Sheets(Sheets.Count))
blnFiles = False: ReDim arrType(0): arrType(0) = ""
If MsgBox("Sollen auch Dateien angezeigt werden?", vbYesNo, "Dateien anzeigen") = vbYes _
Then
blnFiles = True
If MsgBox("Sollen alle Dateien angezeigt werden?", vbYesNo, "alle Dateien anzeigen?" _
) = vbNo Then _
arrType = Split(InputBox("Nur Dateien mit folgenden Endungen angezeigen?" & Chr( _
10) & _
"(Dateiendungen kommagetrennt eingeben)", "Dateityp") & ",", ",")
End If
With ws
.Cells(1, 1).Resize(, UBound(arrNames) + 1) = arrNames
.Cells(1, 1).Resize(, UBound(arrNames) + 1).Interior.Color = 14994616
.Cells(1, 1).Resize(, UBound(arrNames) + 1).Font.Bold = True
.Columns("C:D").NumberFormat = "0.00"
.Columns("F:G").NumberFormat = "dd.mm.yyyy hh:ss"
rec objBrowseDir.self.Path, blnFiles
.Columns.AutoFit
End With
End If
Application.ScreenUpdating = True
Set objBrowseDir = Nothing
End Sub
Function rec(ordner, blnFile)
Dim objFolder As Object, objSubfolder As Object, objFile As Object, rngStart As Range, _
blnType As Boolean
Set objFolder = CreateObject("Scripting.FileSystemObject").GetFolder(ordner)
With ws
.Outline.SummaryRow = xlAbove
.Outline.SummaryColumn = xlRight
.Cells(.Rows.Count, 2).End(xlUp).Offset(1, -1) = ordner
.Cells(.Rows.Count, 2).End(xlUp).Offset(1, 1) = objFolder.Size / 1024 / 1024
.Cells(.Rows.Count, 2).End(xlUp).Offset(1, 4) = objFolder.DateCreated
.Cells(.Rows.Count, 2).End(xlUp).Offset(1, 5) = objFolder.DateLastModified
.Cells(.Rows.Count, 2).End(xlUp).Offset(1) = " "
If blnFile Then
Set rngStart = .Cells(.Rows.Count, 2).End(xlUp).Offset(1, -1)
For Each objFile In objFolder.Files
blnType = True
If arrType(0) "" Then
If Not IsNumeric(Application.Match(Right(objFile.Name, Len(objFile.Name) - _
InStrRev(objFile.Name, ".")), arrType, 0)) Then _
blnType = False
End If
If blnType Then .Cells(.Rows.Count, 2).End(xlUp).Offset(1, 2) = objFile.Size / _
1024 / 1024
If blnType Then .Cells(.Rows.Count, 2).End(xlUp).Offset(1, 3) = objFile.Type
If blnType Then .Cells(.Rows.Count, 2).End(xlUp).Offset(1, 4) = objFile. _
DateCreated
If blnType Then .Cells(.Rows.Count, 2).End(xlUp).Offset(1, 5) = objFile. _
DateLastModified
If blnType Then .Cells(.Rows.Count, 2).End(xlUp).Offset(1, 6) = objFile. _
DateLastAccessed
If blnType Then .Cells(.Rows.Count, 2).End(xlUp).Offset(1) = objFile.Name
Next objFile
If rngStart.Row