Составление списка файлов из папки

Sub ОбработкаФайловИзПапки()
    On Error Resume Next
    Dim folder$
    Dim strFiles As String  'Переменная для полных имен файлов из текущей папки
    Dim strFiles1 As String  'Переменная для кратких имен файлов из текущей папки
    Dim FilenamesCollection As Collection
    Dim i As Integer
 
    i = 0
    folder$ = ThisDocument.Path
    If Dir(folder$, vbDirectory) = "" Then
        MsgBox "Не найдена папка «" & folder$ & "»", vbCritical, "Не найдена папка"
        Exit Sub        ' выход, если папка не найдена
    End If
 
    Set FilenamesCollection = New Collection    ' создаём пустую коллекцию
    Set FSO = CreateObject("Scripting.FileSystemObject")    ' создаём экземпляр FileSystemObject
    
    On Error Resume Next: Set curfold = FSO.GetFolder(folder$)
    If Not curfold Is Nothing Then    ' если удалось получить доступ к папке

        For Each fil In curfold.Files    ' перебираем все файлы в папке FolderPath
            ' получаем список файлов из папки
            If fil.Name Like "*" & Mask Then FilenamesCollection.Add fil.Path
        Next
        Set fil = Nothing: Set curfold = Nothing    ' очищаем переменные
    End If
    
    Set FSO = Nothing  ' очистка переменной

    If FilenamesCollection.Count = 0 Then
        MsgBox "В папке «" & folder$ & "» нет ни одного файла!", _
               vbCritical, "Файлы для обработки не найдены"
        Exit Sub        ' выход, если нет файлов
    End If
 
    strFiles = ""
    strFiles1 = ""
    ' перебираем все найденные файлы
    For Each file In FilenamesCollection
        strFiles = strFiles & file & vbCr  'Полные имена файлов
        strFiles1 = strFiles1 & Replace(file, folder$ & "\", "") & vbCr  'Краткие имена файлов
        i = i + 1
    Next
    Selection.EndKey Unit:=wdStory  'переход в конец файла
    Selection.TypeText "В папке " & i & " файлов" & vbCr
    Selection.TypeText strFiles 'вставка переменной с полными именами в файл
    Selection.TypeText strFiles1 'вставка переменной с краткими именами в файл
    Selection.TypeParagraph
End Sub