Option Explicit
Option Compare Text
Option Base 1
'Public Const App_Title = "File scanner 42"
Const FirstCol = "A"
Private cRow As Long 'current row - increasing with every new record
Private cRng As Range 'current cell - increasing with every new record
Private ScannedSize As Variant 'running sum of scanned files
Sub t42_ScanFilesAndFolders()
On Error GoTo ErrHandler
'Select folder to be scanned
Dim root As String: root = BrowseForFolder
If UCase(root) = "FALSE" Then Exit Sub 'if no folder is selected
If Left(root, 2) = "\\" Then MsgBox "Cannot scan network drives yet!", vbOKOnly: Exit Sub
If Right(root, 1) <> "\" Then root = root & "\" 'make sure we have \ at the end
Dim AbsLevel As Long: AbsLevel = UBound(Split(root, "\")) - 1 'directory depth of root in the drive
Dim RL As Long: RL = 0 'relative directory level - root=0
Dim scanTime As String: scanTime = Format(Now(), "yyyymmdd-hhmmss")
Dim drv As String: drv = Left(root, 1)
Dim drvFree As Variant: drvFree = DrvGetFreeSpace(drv)
Dim drvFull As Variant: drvFull = DrvGetOccupiedSpace(drv)
Dim drvTotal As Variant: drvTotal = drvFree + drvFull
Dim ColHeaders As String: ColHeaders = "Object,Name,Extension,Type,Size,Full path,Parent folder,Relative level,Attributes,Date created,Date Modified,Date accessed"
Dim i As Long, j As Long
' Stop
Dim wb As Workbook
If Not ActiveWorkbook Is Nothing Then
Set wb = ActiveWorkbook
i = 1
Else
Set wb = Workbooks.Add
i = 0
End If
Dim wsh As Worksheet
With wb
If i = 1 Then
Set wsh = .Worksheets.Add(, .Worksheets(.Worksheets.Count))
Else
Set wsh = .ActiveSheet
End If
End With
wsh.Name = "Scan " & scanTime
wsh.Activate
Dim rng As Range: Set rng = wsh.Range("A1")
Dim rngDur As Range
Dim VarTime As Variant
i = 0
With rng
.Value = "Scan time:"
.Offset(, 1) = scanTime
i = i + 1
.Offset(i, 0).Value = "Selected drive:"
.Offset(i, 1).Value = drv
i = i + 1
.Offset(i, 0).Value = "Capacity:"
.Offset(i, 1).Value = Round(drvTotal / 1024 ^ 3, 3) & " GB"
.Offset(i, 2).Value = drvTotal
.Offset(i, 2).NumberFormat = "#,##0"
With .Offset(i, 4)
.Value = "Folder(s) count:"
.HorizontalAlignment = xlRight
.Interior.Color = 65535
.Font.Bold = True
With .Offset(, 1)
.FormulaR1C1 = "=COUNTIF(C[-5],""Folder"")"
.HorizontalAlignment = xlLeft
.InsertIndent 1
End With
End With
i = i + 1
.Offset(i, 0).Value = "Free space:"
.Offset(i, 1).Value = Round(drvFree / 1024 ^ 3, 3) & " GB"
.Offset(i, 2).Value = drvFree
.Offset(i, 2).NumberFormat = "#,##0"
With .Offset(i, 4)
.Value = "File(s) count:"
.HorizontalAlignment = xlRight
.Interior.Color = 65535
.Font.Bold = True
With .Offset(, 1)
.FormulaR1C1 = "=COUNTIF(C[-5],""File"")"
.HorizontalAlignment = xlLeft
.InsertIndent 1
End With
End With
i = i + 1
.Offset(i, 0).Value = "Occupied space:"
.Offset(i, 1).Value = Round(drvFull / 1024 ^ 3, 3) & " GB"
.Offset(i, 2).Value = drvFull
.Offset(i, 2).NumberFormat = "#,##0"
With .Offset(i, 4)
.Value = "Scanned size:"
.HorizontalAlignment = xlRight
.Interior.Color = 65535
.Font.Bold = True
With .Offset(, 1)
.FormulaR1C1 = "=SUBTOTAL(9,C[-1])"
.NumberFormat = "#,##0"
.HorizontalAlignment = xlRight
' .InsertIndent 1
.Offset(, 1).FormulaR1C1 = "=ROUND(C[-1]/1024^3,3)"
.Offset(, 2).Value = "GB"
End With
End With
i = i + 1
.Offset(i, 0).Value = "Selected folder:"
.Offset(i, 1).Value = root
If Len(root) > 3 Then
.Offset(i, 2).Value = FldGetFolderSize(root)
.Offset(i, 2).NumberFormat = "#,##0"
End If
i = i + 1
.Offset(i, 0).Value = "Root level:"
.Offset(i, 1).Value = AbsLevel
i = i + 1
.Offset(i, 0).Value = "Scan duration:"
Set rngDur = .Offset(i, 1)
.Offset(i, 2) = "seconds"
Range(.Address & ":" & .Offset(i, 1).Address).Interior.Color = 65535
Range(.Address & ":" & .Offset(i, 0).Address).Font.Bold = True
Range(.Address & ":" & .Offset(i, 0).Address).HorizontalAlignment = xlRight
Range(.Address & ":" & .Offset(i, 0).Address).InsertIndent 1
Range(.Offset(0, 1).Address & ":" & .Offset(i, 1).Address).HorizontalAlignment = xlLeft
i = i + 3
End With
wsh.Columns("A:B").EntireColumn.AutoFit
Set cRng = wsh.Range(FirstCol & i)
With cRng.Resize(1, UBound(Split(ColHeaders, ",")) + 1)
.Cells = Split(ColHeaders, ",")
.Interior.Color = 65535
.Font.Bold = True
End With
Set cRng = cRng.Offset(1)
cRng.Select
DoEvents
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
'Start scanning
VarTime = VBA.DateTime.Timer
Call checkSubfolders42(root, 0)
rngDur.Value = VBA.DateTime.Timer - VarTime
With wsh
.Columns("A:E").EntireColumn.AutoFit
.Columns("H:L").EntireColumn.AutoFit
.Columns("F:F").ColumnWidth = .Columns("C:C").ColumnWidth
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
wb.Activate
If wb.Path = "" Then Application.Dialogs(xlDialogSaveAs).Show Else wb.Save
exitPoint:
On Error Resume Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Set wb = Nothing
Set wsh = Nothing
Set rng = Nothing
Set rngDur = Nothing
Set cRng = Nothing
drvFree = Null
drvFull = Null
drvTotal = Null
ScannedSize = Null
cRow = 0
VarTime = Null
Exit Sub
ErrHandler:
MsgBox "An error occurred." & vbCrLf & _
"Number: " & Err.Number & vbCrLf & _
"Description: " & Err.Description & vbCrLf & _
"Error line: " & Erl, vbOKOnly
End Sub
Function BrowseForFolder(Optional OpenAt As Variant = 17) As Variant
'Function purpose: To Browser for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE: If invalid, it will open at the Desktop level
'Table 12-4 Constants for the Third Parameter of BrowseForFolder*
'
'Constant Description
'&H0001 Only file system folders can be selected. If this bit is set, the OK button is disabled if the user selects a folder that doesn't belong to the file system (such as the Control Panel folder).
'&H0002 The user is prohibited from browsing below the domain within a network (during a computer search).
'&H0004 Room for status text is provided under the text box. (I haven't found a way to show the status, however.)
'&H0008 Returns file system ancestors only.
'&H0010 Shows an edit box in the dialog box for the user to type the name of an item.
'&H0020 Validate the name typed in the edit box.
'&H1000 Enables the user to browse the network branch of the shell's namespace for computer names.
'&H2000 Enables the user to browse the network branch of the shell's namespace for printer names.
'&H4000 Allows browsing for everything.
'
'iOptions [in]
'Type: Integer
'An Integer value that contains the options for the method.
'This can be zero or a combination of the values listed under the ulFlags member of the BROWSEINFO structure.
'Flags that specify the options for the dialog box. This member can be 0 or a combination of the following values. Version numbers refer to the minimum version of Shell32.dll required for SHBrowseForFolder to recognize flags added in later releases. See Shell and Common Controls Versions for more information.
'
'BIF_RETURNONLYFSDIRS (0x00000001)
'0x00000001. Only return file system directories. If the user selects folders that are not part of the file system, the OK button is grayed.
'Note The OK button remains enabled for "\\server" items, as well as "\\server\share" and directory items. However, if the user selects a "\\server" item, passing the PIDL returned by SHBrowseForFolder to SHGetPathFromIDList fails.
'
'BIF_DONTGOBELOWDOMAIN (0x00000002)
'0x00000002. Do not include network folders below the domain level in the dialog box's tree view control.
'
'BIF_STATUSTEXT (0x00000004)
'0x00000004. Include a status area in the dialog box. The callback function can set the status text by sending messages to the dialog box. This flag is not supported when BIF_NEWDIALOGSTYLE is specified.
'
'BIF_RETURNFSANCESTORS (0x00000008)
'0x00000008. Only return file system ancestors. An ancestor is a subfolder that is beneath the root folder in the namespace hierarchy. If the user selects an ancestor of the root folder that is not part of the file system, the OK button is grayed.
'
'BIF_EDITBOX (0x00000010)
'0x00000010. Version 4.71. Include an edit control in the browse dialog box that allows the user to type the name of an item.
'
'BIF_VALIDATE (0x00000020)
'0x00000020. Version 4.71. If the user types an invalid name into the edit box, the browse dialog box calls the application's BrowseCallbackProc with the BFFM_VALIDATEFAILED message. This flag is ignored if BIF_EDITBOX is not specified.
'
'BIF_NEWDIALOGSTYLE (0x00000040)
'0x00000040. Version 5.0. Use the new user interface. Setting this flag provides the user with a larger dialog box that can be resized. The dialog box has several new capabilities, including: drag-and-drop capability within the dialog box, reordering, shortcut menus, new folders, delete, and other shortcut menu commands.
'Note If COM is initialized through CoInitializeEx with the COINIT_MULTITHREADED flag set, SHBrowseForFolder fails if BIF_NEWDIALOGSTYLE is passed.
'
'BIF_BROWSEINCLUDEURLS (0x00000080)
'0x00000080. Version 5.0. The browse dialog box can display URLs. The BIF_USENEWUI and BIF_BROWSEINCLUDEFILES flags must also be set. If any of these three flags are not set, the browser dialog box rejects URLs. Even when these flags are set, the browse dialog box displays URLs only if the folder that contains the selected item supports URLs. When the folder's IShellFolder::GetAttributesOf method is called to request the selected item's attributes, the folder must set the SFGAO_FOLDER attribute flag. Otherwise, the browse dialog box will not display the URL.
'
'BIF_USENEWUI
'Version 5.0. Use the new user interface, including an edit box. This flag is equivalent to BIF_EDITBOX | BIF_NEWDIALOGSTYLE.
'Note If COM is initialized through CoInitializeEx with the COINIT_MULTITHREADED flag set, SHBrowseForFolder fails if BIF_USENEWUI is passed.
'
'BIF_UAHINT (0x00000100)
'0x00000100. Version 6.0. When combined with BIF_NEWDIALOGSTYLE, adds a usage hint to the dialog box, in place of the edit box. BIF_EDITBOX overrides this flag.
'
'BIF_NONEWFOLDERBUTTON (0x00000200)
'0x00000200. Version 6.0. Do not include the New Folder button in the browse dialog box.
'
'BIF_NOTRANSLATETARGETS (0x00000400)
'0x00000400. Version 6.0. When the selected item is a shortcut, return the PIDL of the shortcut itself rather than its target.
'
'BIF_BROWSEFORCOMPUTER (0x00001000)
'0x00001000. Only return computers. If the user selects anything other than a computer, the OK button is grayed.
'
'BIF_BROWSEFORPRINTER (0x00002000)
'0x00002000. Only allow the selection of printers. If the user selects anything other than a printer, the OK button is grayed.
'In Windows XP and later systems, the best practice is to use a Windows XP-style dialog, setting the root of the dialog to the Printers and Faxes folder (CSIDL_PRINTERS).
'
'BIF_BROWSEINCLUDEFILES (0x00004000)
'0x00004000. Version 4.71. The browse dialog box displays files as well as folders.
'
'BIF_SHAREABLE (0x00008000)
'0x00008000. Version 5.0. The browse dialog box can display sharable resources on remote systems. This is intended for applications that want to expose remote shares on a local system. The BIF_NEWDIALOGSTYLE flag must also be set.
'
'BIF_BROWSEFILEJUNCTIONS (0x00010000)
'0x00010000. Windows 7 and later. Allow folder junctions such as a library or a compressed file with a .zip file name extension to be browsed.
'Table 12-5 Constants for the Fourth Parameter of BrowseForFolder
'
'Constant Description
'0 The Desktop (virtual) folder is the root directory. Using this constant along with &H0001 for the third parameter circumvents problems with the OK button.
'1 Internet Explorer is the root.
'2 The Programs folder of the Start menu is the root.
'3 The Control Panel folder is the root. The third parameter must be set to &H4000 (browse for everything).
'4 The Printers folder is the root. The third parameter must be set to &H4000 (browse for everything).
'5 The Documents folder of the Start menu is the root.
'6 The Favorites folder of the Start menu is the root.
'7 The Startup folder of the Start menu is the root. The third parameter must be set to &H4000 (browse for everything).
'8 The Recent folder is the root. The third parameter must be set to &H4000 (browse for everything).
'9 The SendTo folder is the root. The third parameter must be set to &H4000 (browse for everything).
'10 The Recycle Bin folder is the root. The third parameter must be set to &H4000 (browse for everything).
'11 The Start menu folder is the root.
'16 The Desktop (physical) folder is the root.
'17 My Computer is the root.
'18 Network Neighborhood is the root.
'19 The Nethood folder is the root.
'20 The Fonts folder is the root.
'21 The Templates folder is the root.
'' More Values for the OpenAt parameter:
'vRootFolder [in, optional]
'Type: Variant
'The root folder to use in the dialog box.
'The user cannot browse higher in the tree than this folder.
'If this value is not specified, the root folder used in the dialog box is the desktop.
'This value can be a string that specifies the path of the folder or one of the ShellSpecialFolderConstants values.
'Note that the constant names found in ShellSpecialFolderConstants are available in Visual Basic, but not in VBScript or JScript.
'In those cases, the numeric values must be used in their place.
'Constants
'ssfDESKTOP 0x00 (0). Windows desktop—the virtual folder that is the root of the namespace.
'ssfPROGRAMS 0x02 (2). File system directory that contains the user's program groups (which are also file system directories). A typical path is C:\Users\username\AppData\Roaming\Microsoft\Windows\Start Menu\Programs.
'ssfCONTROLS 0x03 (3). Virtual folder that contains icons for the Control Panel applications.
'ssfPRINTERS 0x04 (4). Virtual folder that contains installed printers.
'ssfPERSONAL 0x05 (5). File system directory that serves as a common repository for a user's documents. A typical path is C:\Users\username\Documents.
'ssfFAVORITES 0x06 (6). File system directory that serves as a common repository for the user's favorite URLs. A typical path is C:\Documents and Settings\username\Favorites.
'ssfSTARTUP 0x07 (7). File system directory that corresponds to the user's Startup program group. The system starts these programs whenever any user first logs into their profile after a reboot. A typical path is C:\Users\username\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\StartUp.
'ssfRECENT 0x08 (8). File system directory that contains the user's most recently used documents. A typical path is C:\Users\username\AppData\Roaming\Microsoft\Windows\Recent.
'ssfSENDTO 0x09 (9). File system directory that contains Send To menu items. A typical path is C:\Users\username\AppData\Roaming\Microsoft\Windows\SendTo.
'ssfBITBUCKET 0x0a (10). Virtual folder that contains the objects in the user's Recycle Bin.
'ssfSTARTMENU 0x0b (11). File system directory that contains Start menu items. A typical path is C:\Users\username\AppData\Roaming\Microsoft\Windows\Start Menu.
'ssfDESKTOPDIRECTORY 0x10 (16). File system directory used to physically store the file objects that are displayed on the desktop. It is not to be confused with the desktop folder itself, which is a virtual folder. A typical path is C:\Documents and Settings\username\Desktop.
'ssfDRIVES 0x11 (17). My Computer—the virtual folder that contains everything on the local computer: storage devices, printers, and Control Panel. This folder can also contain mapped network drives.
'ssfNETWORK 0x12 (18). Network Neighborhood—the virtual folder that represents the root of the network namespace hierarchy.
'ssfNETHOOD 0x13 (19). A file system folder that contains any link objects in the My Network Places virtual folder. It is not the same as ssfNETWORK, which represents the network namespace root. A typical path is C:\Users\username\AppData\Roaming\Microsoft\Windows\Network Shortcuts.
'ssfFONTS 0x14 (20). Virtual folder that contains installed fonts. A typical path is C:\Windows\Fonts.
'ssfTEMPLATES 0x15 (21). File system directory that serves as a common repository for document templates.
'ssfCOMMONSTARTMENU 0x16 (22). File system directory that contains the programs and folders that appear on the Start menu for all users. A typical path is C:\Documents and Settings\All Users\Start Menu. Valid only for Windows NT systems.
'ssfCOMMONPROGRAMS 0x17 (23). File system directory that contains the directories for the common program groups that appear on the Start menu for all users. A typical path is C:\Documents and Settings\All Users\Start Menu\Programs. Valid only for Windows NT systems.
'ssfCOMMONSTARTUP 0x18 (24). File system directory that contains the programs that appear in the Startup folder for all users. A typical path is C:\Documents and Settings\All Users\Microsoft\Windows\Start Menu\Programs\StartUp. Valid only for Windows NT systems.
'ssfCOMMONDESKTOPDIR 0x19 (25). File system directory that contains files and folders that appear on the desktop for all users. A typical path is C:\Documents and Settings\All Users\Desktop. Valid only for Windows NT systems.
'ssfAPPDATA 0x1a (26). Version 4.71. File system directory that serves as a common repository for application-specific data. A typical path is C:\Documents and Settings\username\Application Data.
'ssfPRINTHOOD 0x1b (27). File system directory that contains any link objects in the Printers virtual folder. A typical path is C:\Users\username\AppData\Roaming\Microsoft\Windows\Printer Shortcuts.
'ssfLOCALAPPDATA 0x1c (28). Version 5.0. File system directory that serves as a data repository for local (non-roaming) applications. A typical path is C:\Users\username\AppData\Local.
'ssfALTSTARTUP 0x1d (29). File system directory that corresponds to the user's non-localized Startup program group.
'ssfCOMMONALTSTARTUP 0x1e (30). File system directory that corresponds to the non-localized Startup program group for all users. Valid only for Windows NT systems.
'ssfCOMMONFAVORITES 0x1f (31). File system directory that serves as a common repository for the favorite URLs shared by all users. Valid only for Windows NT systems.
'ssfINTERNETCACHE 0x20 (32). File system directory that serves as a common repository for temporary Internet files. A typical path is C:\Users\username\AppData\Local\Microsoft\Windows\Temporary Internet Files.
'ssfCOOKIES 0x21 (33). File system directory that serves as a common repository for Internet cookies. A typical path is C:\Documents and Settings\username\Application Data\Microsoft\Windows\Cookies.
'ssfHISTORY 0x22 (34). File system directory that serves as a common repository for Internet history items.
'ssfCOMMONAPPDATA 0x23 (35). Version 5.0. Application data for all users. A typical path is C:\Documents and Settings\All Users\Application Data.
'ssfWINDOWS 0x24 (36). Version 5.0. Windows directory. This corresponds to the %windir% or %SystemRoot% environment variables. A typical path is C:\Windows.
'ssfSYSTEM 0x25 (37). Version 5.0. The System folder. A typical path is C:\Windows\System32.
'ssfPROGRAMFILES 0x26 (38). Version 5.0. Program Files folder. A typical path is C:\Program Files.
'ssfMYPICTURES 0x27 (39). My Pictures folder. A typical path is C:\Users\username\Pictures.
'ssfPROFILE 0x28 (40). Version 5.0. User's profile folder.
'ssfSYSTEMx86 0x29 (41). Version 5.0. System folder. A typical path is C:\Windows\System32, or C:\Windows\Syswow32 on a 64-bit computer.
'ssfPROGRAMFILESx86 0x30 (48). Version 6.0. Program Files folder. A typical path is C:\Program Files, or C:\Program Files (X86) on a 64-bit computer.
Dim ShellApp As Object
'Create a file browser window at the default folder
' Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", &H1, OpenAt)
'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.Self.Path
On Error GoTo 0
'Destroy the Shell Application
Set ShellApp = Nothing
'Check for invalid or non-entries and send to the Invalid error
'handler if found
'Valid selections can begin L: (where L is a letter) or
'\\ (as in \\servername\sharename. All others are invalid
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
Exit Function
Invalid:
'If it was determined that the selection was invalid, set to False
BrowseForFolder = False
End Function
Public Function DrvGetFreeSpace(drvLetter As String) As Variant
On Error GoTo ErrHandler
Dim drv As String: drv = Trim(drvLetter)
If Len(drv) < 1 Then Err.Raise -10, , "Drive letter is NULL."
' Dim rng2 As Range: Set rng2 = rng1.Offset(rng1.Parent.Rows.Count - rng1.Row).End(xlUp).Offset(1)
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject").GetDrive(drv)
With fso
DrvGetFreeSpace = .FreeSpace
End With
exitPoint:
On Error Resume Next
' Set rng1 = Nothing
' Set rng2 = Nothing
Set fso = Nothing
Exit Function
ErrHandler:
Select Case Err.Number
Case 68
' drv = "Drive " & drv & " not found."
DrvGetFreeSpace = Null
Case Else
DrvGetFreeSpace = "#ERROR#" '& Err.Number & vbCrLf & Err.Description
End Select
Debug.Print drvLetter, Err.Number, Err.Description
Resume exitPoint
End Function
Public Function DrvGetOccupiedSpace(drvLetter As String) As Variant
On Error GoTo ErrHandler
Dim drv As String: drv = Trim(drvLetter)
If Len(drv) < 1 Then Err.Raise -10, , "Drive letter is NULL."
' Dim rng2 As Range: Set rng2 = rng1.Offset(rng1.Parent.Rows.Count - rng1.Row).End(xlUp).Offset(1)
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject").GetDrive(drv)
With fso
DrvGetOccupiedSpace = .TotalSize - .FreeSpace
End With
exitPoint:
On Error Resume Next
' Set rng1 = Nothing
' Set rng2 = Nothing
Set fso = Nothing
Exit Function
ErrHandler:
Select Case Err.Number
Case 68
' drv = "Drive " & drv & " not found."
DrvGetOccupiedSpace = Null
Case Else
DrvGetOccupiedSpace = "#ERROR#" '& Err.Number & vbCrLf & Err.Description
End Select
Debug.Print drvLetter, Err.Number, Err.Description
Resume exitPoint
End Function
Public Function FldGetFolderSize(fldPath As String) As Variant
On Error GoTo ErrHandler
fldPath = Trim(fldPath)
If Len(fldPath) <= 3 Then Err.Raise -10, , "Incorrect folder"
' Dim rng2 As Range: Set rng2 = rng1.Offset(rng1.Parent.Rows.Count - rng1.Row).End(xlUp).Offset(1)
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject").getfolder(fldPath)
FldGetFolderSize = fso.Size
exitPoint:
On Error Resume Next
' Set rng1 = Nothing
' Set rng2 = Nothing
Set fso = Nothing
Exit Function
ErrHandler:
Select Case Err.Number
Case 70
' Permission denied - when drive is elected for example - drv = "Drive " & drv & " not found."
FldGetFolderSize = Null
Case Else
FldGetFolderSize = "#ERROR#" '& Err.Number & vbCrLf & Err.Description
End Select
Debug.Print fldPath, Err.Number, Err.Description
Resume exitPoint
End Function
Sub checkSubfolders42(strDirectory As String, curLevel As Long, Optional SubDepthLimit As Integer = -1, Optional FolderSize As Boolean = False)
If SubDepthLimit > 0 Then _
If curLevel > SubDepthLimit Then Exit Sub
''' if SubDepthLimit = 0 - check NO subFolders
''' if SubDepthLimit < 0 - check ALL subFolders = NO Limits
On Error Resume Next
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
Dim objFile As Object
Dim i As Integer, str1 As String, j As Long
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.getfolder(strDirectory)
If objFolder.SubFolders.Count > 0 Then
'loops through each folder in the directory and prints their names and path
For Each objSubFolder In objFolder.SubFolders
With objSubFolder
'''Folder Properties:
'''Attributes, DateCreated, DateLastAccessed, DateLastModified,Drive,
'''Files, IsRootFolder, Name, ParentFolder, Path,
'''ShortName, ShortPath, Size, SubFolders, Type
'''Folder Methods: .Copy , .CreateTextFile, .Delete, .Move
'''FoldersCollection Properties: Count , Item
'''FoldersCollection Methods: Add
If FolderSize Then
cRng.Resize(1, 12) = _
Array("Folder", .Name, Null, .Type, .Size, _
.Path, .ParentFolder, curLevel, .Attributes, _
.DateCreated, .DateLastModified, .DateLastAccessed)
Else
cRng.Resize(1, 12) = _
Array("Folder", .Name, Null, .Type, Null, _
.Path, .ParentFolder, curLevel, .Attributes, _
.DateCreated, .DateLastModified, .DateLastAccessed)
End If
End With
Set cRng = cRng.Offset(1)
'RECURSION: Routine calls itself to drill down and check the contents before moving to next one
checkSubfolders42 objSubFolder.Path, (curLevel + 1)
Next objSubFolder
End If
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
With objFile
'''File Properties:
'''Attributes, DateCreated, DateLastAccessed, DateLastModified,Drive,
'''Name, ParentFolder, Path, ShortName, ShortPath, Size, Type
'''File Methods: .Copy , .Delete, .Move, .OpenAsTextStream
cRng.Resize(1, 12) = _
Array("File", .Name, objFSO.GetExtensionName(.Path), .Type, .Size, _
.Path, .ParentFolder, curLevel, .Attributes, _
.DateCreated, .DateLastModified, .DateLastAccessed)
End With
Set cRng = cRng.Offset(1)
Next objFile
exitPoint:
Set objFSO = Nothing
Set objFolder = Nothing
Set objSubFolder = Nothing
Set objFile = Nothing
End Sub
