Dim ODn: Set ODn = CreateObject("Scripting.Dictionary")

SELECT Таблица1.Поле1, SUM(Таблица1.Поле2) FROM Таблица1 group by Таблица1.Поле1

Option Explicit
Function FilenamesCollection(ByVal FolderPath As String, Optional ByVal Mask As String = "", _
                     Optional ByVal SearchDeep As Long = 999) As Collection
      Dim FSO As Object
      Set FilenamesCollection = New Collection
      Set FSO = CreateObject("Scripting.FileSystemObject")
      GetAllFileNamesUsingFSO FolderPath, Mask, FSO, FilenamesCollection, SearchDeep
      Set FSO = Nothing
End Function
Function GetAllFileNamesUsingFSO(ByVal FolderPath As String, ByVal Mask As String, ByRef FSO, _
                     ByRef FileNamesColl As Collection, ByVal SearchDeep As Long)
      Dim curfold As Object, fil As Object, sfol As Object
      On Error Resume Next: Set curfold = FSO.GetFolder(FolderPath)
      If Not curfold Is Nothing Then
          For Each fil In curfold.Files
              If fil.Name Like "*" & Mask Then FileNamesColl.Add fil
          Next
          SearchDeep = SearchDeep - 1
          If SearchDeep Then
              For Each sfol In curfold.SubFolders
                  GetAllFileNamesUsingFSO sfol.path, Mask, FSO, FileNamesColl, SearchDeep
              Next
          End If
          Set fil = Nothing: Set curfold = Nothing
      End If
End Function

Sub sdf()
        Dim con As New ADODB.Connection
        Dim RS  As New ADODB.Recordset
        Dim coll As Collection
        Dim ObjFile As Object
        Dim FilePath$, path$, ConnectionString$
        ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.path & ";Extended Properties=dBASE IV"
        'ConnectionString = "Driver={Microsoft dBASE Driver (*.dbf)};DriverID=277;Dbq=" & ThisWorkbook.path
        con.Open ConnectionString$
        con.Execute "create table atable (name Text(50), cnt long)"
        For Each ObjFile In FilenamesCollection(ThisWorkbook.path, ".dbf", 2)
          FilePath = ObjFile.path: path$ = Replace(FilePath, ObjFile.Name, "")
          con.Execute "INSERT INTO atable SELECT Field1 as name, sum(Field2) as cnt From " & ObjFile.Name & " IN '" & path & "' [Dbase IV;DATABASE=" & FilePath & "] group by Field1"
        Next
        RS.Open "select name, sum(cnt) as sumcnt from atable group by name", con, 3, 3
        [A1].CopyFromRecordset RS
        RS.Close
        con.Execute "drop table atable"
        con.Close
        Set con = Nothing: Set RS = Nothing
End Sub

Option Explicit
Function FilenamesCollection(ByVal FolderPath As String, Optional ByVal Mask As String = "", _
                    Optional ByVal SearchDeep As Long = 999) As Collection
     ' Получает в качестве параметра путь к папке FolderPath,
     ' маску имени искомых файлов Mask (будут отобраны только файлы с такой маской/расширением)
     ' и глубину поиска SearchDeep в подпапках (если SearchDeep=1, то подпапки не просматриваются).
     ' Возвращает коллекцию, содержащую полные пути найденных файлов
     ' (применяется рекурсивный вызов процедуры GetAllFileNamesUsingFSO)
      
     Dim FSO As Object
     Set FilenamesCollection = New Collection    ' создаём пустую коллекцию
     Set FSO = CreateObject("Scripting.FileSystemObject")    ' создаём экземпляр FileSystemObject
     GetAllFileNamesUsingFSO FolderPath, Mask, FSO, FilenamesCollection, SearchDeep ' поиск
     Set FSO = Nothing: Application.StatusBar = False    ' очистка строки состояния Excel
End Function

Function GetAllFileNamesUsingFSO(ByVal FolderPath As String, ByVal Mask As String, ByRef FSO, _
                    ByRef FileNamesColl As Collection, ByVal SearchDeep As Long)
     ' перебирает все файлы и подпапки в папке FolderPath, используя объект FSO
     ' перебор папок осуществляется в том случае, если SearchDeep > 1
     ' добавляет пути найденных файлов в коллекцию FileNamesColl
     Dim curfold As Object, fil As Object, sfol As Object
     On Error Resume Next: Set curfold = FSO.GetFolder(FolderPath)
     If Not curfold Is Nothing Then    ' если удалось получить доступ к папке
         ' раскомментируйте эту строку для вывода пути к просматриваемой
         ' в текущий момент папке в строку состояния Excel
         ' Application.StatusBar = "Поиск в папке: " & FolderPath
         For Each fil In curfold.Files    ' перебираем все файлы в папке FolderPath
             If fil.Name Like "*" & Mask Then FileNamesColl.Add fil '.path
         Next
         SearchDeep = SearchDeep - 1    ' уменьшаем глубину поиска в подпапках
         If SearchDeep Then    ' если надо искать глубже
             For Each sfol In curfold.SubFolders    ' перебираем все подпапки в папке FolderPath
             GetAllFileNamesUsingFSO sfol.path, Mask, FSO, FileNamesColl, SearchDeep
             Next
         End If
         Set fil = Nothing: Set curfold = Nothing    ' очищаем переменные
     End If
End Function

Sub sdf()
     Dim con: Set con = CreateObject("ADODB.Connection") 'подключение
     Dim RS: Set RS = CreateObject("ADODB.Recordset") 'рекордсет
     Dim ObjFile As Object
     Dim FilePath$, path$, ConnectionString$
      
     'Строка подключения
     ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.path & ";Extended Properties=dBASE IV"
     'ConnectionString = "Driver={Microsoft dBASE Driver (*.dbf)};DriverID=277;Dbq=" & ThisWorkbook.path
      
     'открываем подключение
     con.Open ConnectionString$
      
     'создаем пустую временную базу данных dbf в папке с этим файлом
     con.Execute "create table atable (name Text(50), cnt long)"
      
     'перебираем найденные файлы dbf в папке с этим файлом и дочерних папках 1го уровня
     'если нужно искать в другой папке, то ее путь нужно указать вместо ThisWorkbook.path
     'например FilenamesCollection("C:\DBase\", ".dbf", 2)
     For Each ObjFile In FilenamesCollection(ThisWorkbook.path, ".dbf", 2)
         FilePath = ObjFile.path: path$ = Replace(FilePath, ObjFile.Name, "")
          
         'добавляем из каждого найденного файла группированные записи по первому полю в созданную временную базу
         con.Execute "INSERT INTO atable SELECT Field1 as name, sum(Field2) as cnt From " & ObjFile.Name & " IN '" & path & "' [Dbase IV;DATABASE=" & FilePath & "] group by Field1"
     Next
      
     'помещаем в рекордсет группированные записи из временной базы
     RS.Open "select name, sum(cnt) as sumcnt from atable group by name", con, 3, 3
      
     'выгружаем данные из рекордсета на лист
     [A1].CopyFromRecordset RS
      
     'закрываем рекордсет
     RS.Close
      
     'удаляем временную базу
     con.Execute "drop table atable"
      
     'закрвыаем подключение
     con.Close
     Set con = Nothing: Set RS = Nothing
End Sub