I have tried to write VBA code to extract the 10 most used folders in Windows except Outlook folders, sub-folders and program folders
However, I get compile error : for each control variable must be variant or object and the code below is highlighted
It would be appreciated if someone could amend my code
See full code below
However, I get compile error : for each control variable must be variant or object and the code below is highlighted
Code:
For Each folderPath In GetFoldersOnDrive("C:\", False)
See full code below
Code:
Sub MostUsedFolders()
Dim dict As Object
Dim arr() As Variant
Dim i As Long
Dim rng As Range
Dim folderPath As String
Dim folder As Object
'Create a dictionary to hold the folder paths and their usage count
Set dict = CreateObject("Scripting.Dictionary")
'Loop through each folder on the C:\ drive
For Each folderPath In GetFoldersOnDrive("C:\", False)
Set folder = CreateObject("Scripting.FileSystemObject").GetFolder(folderPath)
If Not IsOutlookFolder(folder) And Not IsProgramFolder(folder) Then
CountItems folder, dict
End If
Next folderPath
'Put the folder paths and their usage count into an array
ReDim arr(1 To dict.Count, 1 To 2)
i = 1
For Each folderPath In dict
arr(i, 1) = folderPath
arr(i, 2) = dict(folderPath)
i = i + 1
Next folderPath
'Sort the array by the usage count in descending order
SortArray arr
'Clear column A
Set rng = Range("A1", Range("A1").End(xlDown))
rng.ClearContents
'Paste the folder paths into column A
Set rng = Range("A1").Resize(UBound(arr, 1), 1)
rng.Value = arr
End Sub
Function GetFoldersOnDrive(drivePath As String, includeSubfolders As Boolean) As Collection
Dim fso As Object
Dim folder As Object
Dim subFolder As Object
Dim folders As New Collection
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(drivePath)
For Each subFolder In folder.subFolders
If includeSubfolders Then
folders.Add subFolder.Path
Else
folders.Add subFolder.Path, subFolder.Path
End If
Next subFolder
Set GetFoldersOnDrive = folders
End Function
Function CountItems(folder As Object, dict As Object)
Dim item As Object
Dim key As String
'Loop through each item in the folder
For Each item In folder.Files
'If the item is a file, add its parent folder path to the dictionary
key = folder.Path
If dict.Exists(key) Then
dict(key) = dict(key) + 1
Else
dict.Add key, 1
End If
Next item
End Function
Function IsOutlookFolder(folder As Object) As Boolean
Dim folderName As String
folderName = folder.Name
IsOutlookFolder = folderName = "Outlook" Or folderName = "Outlook Files" Or folderName = "Local Settings" Or folderName = "Roaming" Or folderName = "AppData" Or folderName = "Microsoft" Or folderName = "Office"
End Function
Function IsProgramFolder(folder As Object) As Boolean
Dim folderName As String
folderName = folder.Name
IsProgramFolder = folderName = "Program Files" Or folderName = "Program Files (x86)" Or folderName = "Windows"
End Function
Sub SortArray(arr() As Variant)
Dim i As Long
Dim j As Long
Dim temp As Variant
For i = LBound(arr, 1) To UBound(arr, 1) - 1
For j = i + 1 To UBound(arr, 1)
If arr(j, 2) > arr(i, 2) Then
temp = arr(j, 1)
arr(j, 1) = arr(i, 1)
arr(i, 1) = temp
temp = arr(j, 2)
arr(j, 2) = arr(i, 2)
arr(i, 2) = temp
End If
Next j
Next i
End Sub