VBA Count the Files in a Folder

Hello KColgrove,

Here is one way to do it...

Sub GetFileCount()

    Dim Cell    As Range
    Dim Files   As Object
    Dim Folder  As Variant
    
        With CreateObject("Shell.Application")
            For Each Cell In Range("A1", Cells(Rows.Count, "A").End(xlUp))
                Set Folder = .Namespace(Cell.Value)
                If Not Folder Is Nothing Then
                    Set Files = Folder.Items
                    Files.Filter 64, "*.xls"
                    Cell.Offset(0, 1).Value = Files.Count
                Else
                    Cell.Offset(0, 1).Value = "Folder not found."
                End If
            Next Cell
        End With
        
End Sub

Hello KColgrove,

This version of the macro adds a Comment to each cell in column "B" to display the files when you mouse over the cell.

Sub GetFilesAndCount()

    Dim Cell    As Range
    Dim File    As Variant
    Dim Files   As Object
    Dim Folder  As Variant
    Dim n       As Long
    Dim Note    As Comment
    Dim Text    As String
    
        With CreateObject("Shell.Application")
            For Each Cell In Range("A1", Cells(Rows.Count, "A").End(xlUp))
                Set Folder = .Namespace(Cell.Value)
                If Not Folder Is Nothing Then
                    Set Files = Folder.Items
                    Files.Filter 64, "*.xls"
                    Cell.Offset(0, 1).Value = Files.Count
                Else
                    Cell.Offset(0, 1).Value = "Folder not found."
                End If
                
                Text = ""
                Set Note = Cell.Offset(0, 1).Comment
                    If Not Note Is Nothing Then Note.Delete
                Set Note = Cell.Offset(0, 1).AddComment
                    Note.Shape.TextFrame.AutoSize = True
                    
                For Each File In Files
                    Text = File & vbLf
                    n = Note.Shape.TextFrame.Characters.Count + 1
                    Note.Shape.TextFrame.Characters(n, Len(Text)).Insert Text
                    n = n + Len(Text)
                Next File
                
            Next Cell
        End With
        
End Sub