Option Explicit
'Dim objArgs
Dim strFileName

'If Not WScript.Arguments.Named.Exists("FileName") Then
'    WScript.Echo "Using: " & WScript.ScriptName & " /FileName:<file for find>"
'    WScript.Quit 1
'End If

'strFileName = WScript.Arguments.Named.Item("FileName")

strFileName = "primer.txt" ' — имя файла для поиска писать здесь
Dim objFSO
Dim objDrive
ReDim arrPaths(0)
Dim i
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
arrPaths(LBound(arrPaths)) = False
For Each objDrive In objFSO.Drives
If objDrive.DriveType = 2 Then
If objDrive.IsReady Then
FindInSubFolders objDrive.RootFolder, strFileName
End If
End If
Next
If arrPaths(LBound(arrPaths)) Then
WScript.Echo "Found paths for file [" & strFileName & "]:"
For i = LBound(arrPaths) + 1 To UBound(arrPaths)
WScript.Echo arrPaths(i)
Next
Else
WScript.Echo "Not found paths for file [" & strFileName & "]."
End If
Set objFSO = Nothing
WScript.Quit 0

Sub FindInSubFolders(objFolderForFind, strFileName)
Dim objFolder
'WScript.Echo objFolderForFind.Path
If objFSO.FileExists(objFSO.BuildPath(objFolderForFind, strFileName)) Then
ReDim Preserve arrPaths(Ubound(arrPaths) + 1)
arrPaths(LBound(arrPaths)) = True
arrPaths(UBound(arrPaths)) = objFSO.BuildPath(objFolderForFind, strFileName)
'WScript.Echo "Found file [" & strFileName & "] on folder [" & objFolderForFind.Path & "]"
End If
On Error Resume Next
For Each objFolder In objFolderForFind.SubFolders
If Err.Number = 0 Then
FindInSubFolders objFolder, strFileName
Else
Err.Clear
'WScript.Echo "Can't enumerate subfolders for folder [" & objFolderForFind.Path & "]"
End If
Next
On Error Goto 0
End Sub