Отображение имен файлов, имеющих дубликаты в конкретной папке - VBA

Формулировка задачи:

Добрый день! Стоит задача, вывести список файлов, для которых в данной папке имеются дубликаты (1 и более). Дубликаты отличаются только добавлением в конце имени доп.части (1), (2) и т.д., как это делает обычно система Windows. Файлы формата txt. Исходные данные: moloko.txt kefir.txt moloko (1).txt sahar.txt moloko (2).txt sahar (1).txt Вывод: moloko.txt sahar.txt

Решение задачи: «Отображение имен файлов, имеющих дубликаты в конкретной папке»

textual
                            Листинг программы 
                        

                            Sub FindDuplicateFiles()
    Dim d As Object, p As Long, n As String, k As Variant
    Set d = CreateObject("Scripting.Dictionary")
    n = Dir("C:\Temp\" & "*.txt") 'Вместо C:\Temp\ необходимо указать путь к папке с файлами.
    While n <> vbNullString
        n = Left(n, Len(n) - 4) 'Отсекаем расширение.
        p = InStrRev(n, "(")
        If p > 0 Then If IsNumeric(Mid(n, p + 1, 1)) Then n = Trim(Left(n, p - 1)) 'Отсекаем скобки с цифрами (если есть).
        If d.Exists(n) Then d(n) = 1& Else d.Add n, 0& 'Запоминаем имя файла, либо ставим пометку, что найден дубликат.
        n = Dir
    Wend
    For Each k In d
        If d(k) = 1& Then Debug.Print k & ".txt" 'Выводим дубликаты.
    Next k
End Sub
                        