How can I count files in folder

You don't need VBA for this, standard Excel functions can compute these counts.

Column B is used to extract the filename from the path:

=MID(A1,FIND("*",SUBSTITUTE(A1,"\","*",LEN(A1)-LEN(SUBSTITUTE(A1,"\",""))))+1,LEN(A1))

Column C is then used to extract the path:

=LEFT(A1,LEN(A1)-LEN(B1))

Finally, Column D can count the number of files that reside in the same directory:

=COUNTIF(C:C,$C1)

If you really do need to do this in VBA, then here's a couple of functions that will extract the filename or directory given a full path:

' Returns the file name given a full file path
Function BaseName(FilePath)
    BaseName = Mid(FilePath, InStrRev(FilePath, "\") + 1)
End Function

' Returns the directory path given a full file path
Function DirName(FilePath)
    DirName = Mid(FilePath, 1, Len(FilePath) - Len(BaseName(FilePath)))
End Function

Count Files in Folder From a List of File Paths

• The given list of file paths is in A2:A20.
• The result of the 1st procedure, CountFilesPerFolder, is in B2:B20.
• The result of the 2nd procedure, ListFilesCountPerFolder, is in E2:F8.

The Excel Formula to Get the Folder Paths (Evaluate)

=LEFT(A2,FIND("*",SUBSTITUTE(A2,"\","*",LEN(A2)-LEN(SUBSTITUTE(A2,"\",""))))-1)

The Code

Option Explicit


Sub CountFilesPerFolder()
    
    ' Source
    Const sCol As String = "A"
    ' Destination
    Const dCol As String = "B"
    ' Both
    Const fRow As Long = 2
    
    ' Reference the worksheet.
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    ' Reference the one-column range containing the file paths by using
    ' the End property to calculate the last row.
    Dim slRow As Long: slRow = ws.Cells(ws.Rows.Count, sCol).End(xlUp).Row
    Dim rCount As Long: rCount = slRow - fRow + 1
    If rCount < 1 Then Exit Sub ' column range is empty
    Dim srg As Range: Set srg = ws.Cells(fRow, sCol).Resize(rCount)
    Dim sAddress As String: sAddress = srg.Address
    
    ' Write the folder paths to an array by using the Evaluate method.
    Dim Data As Variant
    Data = ws.Evaluate("LEFT(" & sAddress & ",FIND(""*"",SUBSTITUTE(" _
        & sAddress & ",""\"",""*"",LEN(" & sAddress & ")-LEN(SUBSTITUTE(" _
        & sAddress & ",""\"",""""))))-1)")
        
    ' Write the folder paths from the array to the keys of a dictionary
    ' using its items to count the files.
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    Dim Key As Variant
    Dim r As Long
    For r = 1 To rCount
        Key = Data(r, 1)
        If Not IsError(Key) Then
            If Len(Key) > 0 Then
                dict(Key) = dict(Key) + 1
            End If
        End If
    Next r
    If dict.Count = 0 Then Exit Sub ' only blanks and error values
    
    ' Write the files count from the items of the dictionary
    ' to the array (overwriting the folder paths).
    For r = 1 To rCount
        Key = Data(r, 1)
        If dict.Exists(Key) Then
            Data(r, 1) = dict(Key)
        Else
            Data(r, 1) = Empty
        End If
    Next r
    
    ' Write the files count from the array to the destination one-column range
    ' and clear the contents below.
    With srg.EntireRow.Columns(dCol)
        .Resize(rCount).Value = Data
        .Resize(ws.Rows.Count - .Row - rCount + 1).Offset(rCount).ClearContents
    End With
    
End Sub


Sub ListFilesCountPerFolder()
    
    ' Source
    Const sCol As String = "A"
    ' Destination
    Const dCol As String = "E"
    ' Both
    Const fRow As Long = 2
    
    ' Reference the worksheet.
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    ' Reference the one-column range containing the file paths by using
    ' the End property to calculate the last row.
    Dim slRow As Long: slRow = ws.Cells(ws.Rows.Count, sCol).End(xlUp).Row
    Dim rCount As Long: rCount = slRow - fRow + 1
    If rCount < 1 Then Exit Sub ' column range is empty
    Dim srg As Range: Set srg = ws.Cells(fRow, sCol).Resize(rCount)
    Dim sAddress As String: sAddress = srg.Address
    
    ' Write the folder paths to an array by using the Evaluate method.
    Dim Data As Variant
    Data = ws.Evaluate("LEFT(" & sAddress & ",FIND(""*"",SUBSTITUTE(" _
        & sAddress & ",""\"",""*"",LEN(" & sAddress & ")-LEN(SUBSTITUTE(" _
        & sAddress & ",""\"",""""))))-1)")
        
    ' Write the folder paths from the array to the keys of a dictionary
    ' using its items to count the files.
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    Dim Key As Variant
    Dim r As Long
    For r = 1 To rCount
        Key = Data(r, 1)
        If Not IsError(Key) Then
            If Len(Key) > 0 Then
                dict(Key) = dict(Key) + 1
            End If
        End If
    Next r
    rCount = dict.Count
    If rCount = 0 Then Exit Sub ' only blanks and error values
    
    ' Resize the array according to the number of key-value pairs
    ' of the dictionary and write the data from the dictionary to the array.
    ReDim Data(1 To rCount, 1 To 2)
    r = 0
    For Each Key In dict.Keys
        r = r + 1: Data(r, 1) = Key: Data(r, 2) = dict(Key)
    Next Key
    
    ' Write the data from the array to the destination two-column range
    ' and clear the contents below.
    With srg.EntireRow.Columns(dCol).Resize(, 2)
        .Resize(rCount).Value = Data
        .Resize(ws.Rows.Count - .Row - rCount + 1).Offset(rCount).ClearContents
    End With
    
End Sub