Option Explicit
'On Error Resume Next
Dim FolderPath
Dim objFSO
Dim objFolder
Dim colFiles
Dim objFile
Dim tf
Dim WShell

FolderPath = "C:\file"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(FolderPath)
Set colFiles = objFolder.Files
Set tf = objFSO.CreateTextFile("C:\new_folder.txt", True)

For Each objFile in colFiles
	' Записать строку с переводом на новую строку.
	tf.WriteLine(objFile.Name) 
Next
tf.Close

' Поиск строк в документах с выводом в лог

Option Explicit: Dim List, Folder, LogFile, FSO, Dict,_
ShAp, Word, Verb, LogStream, F, Items, I, Doc, Sel, Key

List = "C:\names.txt"         ' путь к списку нужных строк
Folder = "C:\files"           ' путь к папке с документами
LogFile = Date & " FOUND.log" ' имя лога рядом со скриптом

Set FSO  = CreateObject("Scripting.FileSystemObject")
Set Dict = CreateObject("Scripting.Dictionary")
Set ShAp = CreateObject("Shell.Application")
Set Word = CreateObject("Word.Application")
Word.Visible = False : Verb = "сформирован"
If FSO.FileExists(LogFile) Then Verb = "переписан"
Set LogStream = FSO.CreateTextFile(LogFile, True, True)
With FSO.OpenTextFile(List)
  Do : F = .ReadLine
    Dict.Add F, ""
  Loop Until .AtEndOfStream : .Close
End With

Set Items = ShAp.NameSpace(Folder).Items
Items.Filter 8256,  "*.doc;*.docx;*.rtf"
For Each I In Items
  If Left(I.Name, 2) <> "~$" Then
    Set Doc = Word.Documents.Open(I.Path, False, False)
    Set Sel = Word.Selection
    For Each Key In Dict.Keys
      Sel.Find.Text = CStr(Key) : Sel.Find.Forward = True
      Sel.Find.MatchWholeWord = True : If Sel.Find.Execute Then _
      LogStream.WriteLine CStr(Key) & " in " & I : Exit For
    Next : Doc.Close
  End If
Next : Word.Quit : LogStream.Close
If MsgBox("Лог файл " & Verb & ". Желаете открыть?", 4132,_
"Создание лога по наличию строк в файлах      ") = 6 Then _
ShAp.ControlPanelItem LogFile

Вопрос: нужно искать каждое число в файлах отдельно или всё же для индикации присутствия достаточно найти первое попавшееся?

Проще - не проще, но при 500 файлах лог получится примерно с 2,5 млн строками размером до 0,5 Гб.

23254544
66544886
5466645465
4456645465
.............

5466645465 in 1.doc

dim oFso, oShell, oShellEnv
set oFso      = CreateObject("Scripting.FileSystemObject")
set oShell    = WScript.CreateObject("WScript.Shell")
sLogFile1 = sCurFolder & Date() & " FOUND"  & ".log" ' лог для найденой строчки
sLogFile2 = sCurFolder & Date() & " NOT FOUND"  & ".log" 'лог для не найденой строчки
set oTS1 = oFSO.CreateTextFile(sLogFile1, true) ' true - overwrite
set oTS2 = oFSO.CreateTextFile(sLogFile2, true) ' true - overwrite
Set objWord = CreateObject("Word.Application")
objWord.Visible = False

Set objDoc = objWord.Documents.Open("D:\111\1.doc")
Set objSelection = objWord.Selection

objSelection.Find.Text = "25477191"
objSelection.Find.Forward = TRUE
objSelection.Find.MatchWholeWord = TRUE

If objSelection.Find.Execute Then
    oTS1.WriteLine objSelection.Find.Text
Else
    oTS2.WriteLine objSelection.Find.Text
End If
objDoc.Close

option explicit
Dim objFSO, txtFile, x
Set objFSO = Createobject("Scripting.FileSystemObject")
Set txtFile = objFSO.OpenTextFile("echo.txt",1)

Do  While Not txtFile.AtEndOfStream
  x=txtFile.Readline
  If InStr(x, "текст2") Then
      MsgBox "Нашли второй"
      Exit Do
    Elseif InStr(x, "текст5") Then
      Msgbox "Нашли пятый"
      Exit Do
    ElseIf txtFile.AtEndOfStream Then Msgbox "Этих строчек в файле нет"
  End If
Loop

txtFile.Close

option explicit
Dim objFSO, txtFile, x, done
Set objFSO = Createobject("Scripting.FileSystemObject")
Set txtFile = objFSO.OpenTextFile("echo.txt",1)

Do While Not txtFile.AtEndOfStream
  x=txtFile.Readline
  If InStr(x, "текст2") Then
      MsgBox "Нашли второй"
      done = true
      Exit Do
    Elseif InStr(x, "текст5") Then
      Msgbox "Нашли пятый"
      done = true
      Exit Do
'    Else Msgbox "Этих строчек в файле нет"
'      Exit Do
  End If
Loop
If Not done Then Msgbox "Этих строчек в файле нет"
txtFile.Close

 Set objFSO = Createobject("Scripting.FileSystemObject") 
   Set txtFile = objFSO.OpenTextFile(FileName,1) 

x=txtFile.Readline

    Do While Not txtFile.AtEndOfStream
                If InStr(x, "текст2") Then 
                     MsgBox "Нашли второй"
                     Exit Do 
               Elseif InStr(x, "текст5") Then 
                     Msgbox "Нашли пятый"
                       Exit Do  
               Else Msgbox "Этих строчек в файле нет" 
          Exit Do
          End If
    Loop
   txtFile.Close
 End Sub

      
Do While Not txtFile.AtEndOfLine
          If InStr(txtFile.ReadLine, текст2) Then 
               MsgBox "Нашли второй"
               Exit Do 
          Elseif InStr(txtFile.ReadLine, текст5) Then 
               Msgbox "Нашли пятый"
               Exit Do  
      Else Msgbox "Этих строчек в файле нет"
          End If 
     Loop
   txtFile.Close