Hi all - hopefully a quick question.
I've got some code (below) that scans a specified directory for 'top level sub-folders and drops the modified date, path, number of sub-folders in each sub-folder and sub-folder size into Excel.
This is all working fine - it does everything its meant to. However, I keep getting "Run-time error '70' - permission denied" errors. I've checked, and all the folders I'm looking at aren't protected, and it only seems to occur when the code is attempting to determine the size of the folder. Commenting out/removing the lines that deal with folder size makes the rest of it run perfectly.
I've tried to put some error checking in to capture this particular error, but it's not working. The error is occurring, but it doesn't seem to be getting picked up by the OnError statement.
I'm not bothered particularly if I don't get the folder size for each of my sub-folders - at this point I just want to know why the damned error code isn't working.
Any thoughts?
I've got some code (below) that scans a specified directory for 'top level sub-folders and drops the modified date, path, number of sub-folders in each sub-folder and sub-folder size into Excel.
Code:
Sub ListTopSubFolders()
' lists information about the folders in SourceFolder
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim r As Long
Dim strFolderName As String
strFolderName = BrowseFolder("Choose Folder For Import")
If Len(strFolderName) > 0 Then
'line added by dr to clear old data
Cells.Delete
' add headers
With Range("A1")
.Formula = "Folder contents:"
.Font.Bold = True
.Font.Size = 12
End With
Range("A3").Formula = "Last Modified:"
Range("B3").Formula = "Folder Path:"
Range("C3").Formula = "Subfolders:"
Range("D3").Formula = "Size:"
Range("A3:G3").Font.Bold = True
Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(strFolderName)
For Each SubFolder In SourceFolder.SubFolders
Set SourceFolder = FSO.GetFolder(SubFolder.Path)
[b][COLOR=red]On Error GoTo ErrHandler[/color][/b]
' display folder properties
r = Range("A65536").End(xlUp).Row + 1
Cells(r, 1).Formula = SourceFolder.DateLastModified
Cells(r, 2).Formula = SourceFolder.Path
Cells(r, 3).Formula = SourceFolder.SubFolders.Count
[b][COLOR=red]Cells(r, 4).Formula = SourceFolder.Size[/color][/b]
Next SubFolder
Columns("A:G").AutoFit
Set SourceFolder = Nothing
Set SubFolder = Nothing
Set FSO = Nothing
Range("A3:D" & r).Select
Selection.AutoFilter
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Else
'No folder chosen, or user canceled
End If
[COLOR=red][b]ErrHandler:[/b]
If Err.Number = 70 Then
Debug.Print "Sub-folder: " & SourceFolder.Path & " could not be accessed."
Cells(r, 4).Formula = "N/A"
End If
Resume Next[/color]
End Sub
I've tried to put some error checking in to capture this particular error, but it's not working. The error is occurring, but it doesn't seem to be getting picked up by the OnError statement.
I'm not bothered particularly if I don't get the folder size for each of my sub-folders - at this point I just want to know why the damned error code isn't working.
Any thoughts?