Verificando o tamanho das pastas e listando no Excel

Option Explicit
 
Dim objFSO      As Object
Dim pasta       As Object
Dim subpasta    As Object
Dim linha       As Integer
 
Dim diretorio   As String
Dim UserFile    As String
 
Private Sub cmd_verifica_Click()
   
    UserFile = GetDirectory("Selecione a pasta")
    If UserFile = "" Then
        Exit Sub
    Else
        Me.MousePointer = fmMousePointerHourGlass
        Call subpastas(UserFile)
        Me.MousePointer = fmMousePointerDefault
        Unload Me
    End If
   
End Sub
 
Sub subpastas(diretorio As String)
 
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set pasta = objFSO.GetFolder(diretorio)
    Set subpasta = pasta.SubFolders
   
    ActiveSheet.Range("A1").CurrentRegion.Clear
    linha = 2
   
    ActiveSheet.Cells(1, 1) = "Nome da pasta"
    ActiveSheet.Cells(1, 2) = "Tamanho"
   
    For Each pasta In subpasta
        DoEvents
        ActiveSheet.Cells(linha, 1) = Mid(diretorio, 3, 99) & "\" & pasta.Name
        ActiveSheet.Cells(linha, 2) = pasta.Size
        linha = linha + 1
    Next
   
    ActiveSheet.Columns("A:B").AutoFit
    ActiveSheet.Range("B:B").NumberFormat = "#,##0"
    Call classifica
    ActiveSheet.Cells(1, 1).Select
       
End Sub
 
Sub classifica()
 
    Columns("A:B").Select
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("B2:B100"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A1:B100")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
End Sub