Отбор файлов по списку и вывод на печать - VB

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

Помогите автоматизировать задачу Есть список фрагментов названий файлов (колонка в Excel), по нему нужно искать файлы в заданном каталоге и выводить на печать найденные.Ссылка (битая) удалена нашел частичное решение задачи, но ни как не получается переделать.

Решение задачи: «Отбор файлов по списку и вывод на печать»

textual
                            Листинг программы 
                        
 
                            
                        
Option Explicit
 
Const inputFolder = "C:\temp\"  'корневая папка
Const logName = "log.txt"       'будет создан или дополнен в inputFolder
Dim folderCount As Long, stbar As Boolean, startTime As Date
Dim frags() As String, fragsCount As Long
Dim miDoc As Object, ff As Integer
 
Sub Alexanderr()
Dim x As Range, i As Long
    'формируем массив со строками для сравнения
Set x = Range("A1").End(xlDown)
If x = "" Then x = Range("A1")  'в списке одно значение
fragsCount = x.Row
ReDim frags(fragsCount)
For i = 1 To fragsCount
    frags(i) = "*" & Cells(i, 1) & "*"
Next
Set miDoc = CreateObject("modi.document")
ff = FreeFile
Open inputFolder & logName For Append As ff
startTime = Time
folderCount = 0
stbar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
  
Print #ff, "******* начало печати файлов " & Date & " " & Time
'   запускает процесс с исходной папки
processFolder inputFolder
Print #ff, "******* конец печати файлов " & Date & " " & Time & _
    ", папок " & folderCount & ", время " & Format(Time - startTime, "hh:mm:ss")
Close #ff
Application.DisplayStatusBar = stbar
Application.StatusBar = False
Debug.Print folderCount & Format(Time - startTime, ", hh:mm:ss")
End Sub
  
 
Private Sub processFolder(fName As String)
Dim fso As Object, file As Object, fileName As String, i As Long
folderCount = folderCount + 1
Application.StatusBar = folderCount & " " & fName
Set fso = CreateObject("scripting.filesystemobject")
Set fso = fso.getfolder(fName)
  
'   Для каждого файла в папке ...
For Each file In fso.Files
    fileName = file.Name
    For i = 1 To fragsCount
'   Если значение ячейки содержится в имени файла, то в файл-лог выводится путь к файлу,
'   файл распечатывается
       If fileName Like frags(i) Then
            Print #ff, file.Path,
            On Error Resume Next
            miDoc.Create file.Path
            If Err Then
              Err.Clear
              Print #ff, "ERROR"
            Else
              Print #ff, "OK"
              miDoc.PrintOut
            End If
            Exit For
        End If
    Next
Next
  
'   Для каждой подпапки в папке просто вызывается эта же подпрограмма!
For Each file In fso.subfolders
    processFolder file.Path
Next
 
End Sub