Sub OpenAndPrint()

Dim i As Integer, FilePath As String, Paus As Long
Dim FL

FilePath = "C:\Temp\" 'please, insert our path to folder-source
URL = Dir(FilePath & "*" & Selection.Value & "*")
If URL = "" Then MsgBox "File NOT found", vbCritical, "": Exit Sub
URL = FilePath & URL
' URL = "C:\Temp\" & Cells(i, "A") 'opening of the file, associated with application
CreateObject("WScript.Shell").Run URL

Paus = 100 'time for delay (mS)
Delay (Paus)

SendKeys "^P", True 'insert "Ctrl+P" (Open window for print)

Paus = 1000 'time for delay (mS)
Delay (Paus)

SendKeys "{Enter}", True 'insert "Enter" (Execute)

Paus = 100 'time for delay (mS)
Delay (Paus)

SendKeys "%{F4}", True 'Close file

End Sub
Private Sub Delay(Paus)

SStime = GetTickCount
DoEvents
Do While GetTickCount - SStime < Paus: DoEvents: Loop

End Sub

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

Close #ff