Option Explicit
'Copies files into subdirectories. If destination directory is
'specified as C:\Windows, the file would be copied into 
'first-level subdirectories C:\Windows\System, C:\Windows\Temp, 
'etc., but would not be not be copied into the top-level 
'C:\Windows or second-level subdirectories like C:\Windows\System\Cache. 
'Read-only files will not be replaced.
'To save typing, the file that needs to be copied can be dropped 
'on the script. Likewise, the parent destination directory defaults 
'to the script location.
'Written by Eric Phelps http://www.ericphelps.com

Dim gblnLog 'As Boolean
Main

Sub Main()
Dim fol 'As Scripting.Folder
Dim fols 'As Scripting.Folders
Dim fs 'As Scripting.FileSystemObject
Dim strFile 'As String
Dim strFolder 'As String
Dim lngCounter 'As Long
	On Error Resume Next
	Set fs = CreateObject("Scripting.FileSystemObject")
	'Get the dropped file name
	If Wscript.Arguments.Count = 1 Then 
		strFile = Wscript.Arguments(0)
	Else
		strFile = ""
	End If
	strFile = InputBox("Enter file you need copied:", "Sub Copy", strFile)
	If strFile = "" Then
		Wscript.Quit 1
	Else
		If Instr(strFile, ":\") = 0 Then
			If fs.FileExists(FileNameInThisDir(strFile)) Then
				strFile = FileNameInThisDir(strFile)
			End If
		End If
	End If
	If Not(fs.FileExists(strFile)) Then Wscript.Quit 1
	'Get the start path
	strFolder = InputBox("Enter parent path below which file should be copied:", "Sub Copy", FileNameInThisDir(""))
	If strFolder = "" Then Wscript.Quit
	strFolder = fs.GetAbsolutePathName(strFolder)
	If Lcase(Right(Wscript.FullName, 12)) = "\wscript.exe" Then
		gblnLog = True
	Else
		If MsgBox("Append program results to a log?", vbYesNo, "Sub Copy") = vbYes Then
			gblnLog = True
		Else
			gblnLog = False
		End If
	End If
	If MsgBox("This is your last question. Okay to copy """ & strFile & """ to directories under """ & strFolder & """?", vbYesNo, "Sub Copy") = vbNo Then Wscript.Quit
	Status "*************************************"
	Status "*************************************"
	Status "Program:		" & Wscript.ScriptFullName
	Status "Copying:		" & strFile
	Status "Below:		  " & strFolder
	Status "Starting Time:  " & Now
	'Get the list of subdirectories
	Set fol = fs.GetFolder(strFolder)
	Set fols = fol.SubFolders
	For each fol in fols
		fs.CopyFile strFile, fs.BuildPath(fol.Path, fs.GetFileName(strFile)), True
		If Err.Number = 0 Then
			Status fs.BuildPath(fol.Path, fs.GetFileName(strFile)) & " [OK]"
		Else
			Status fs.BuildPath(fol.Path, fs.GetFileName(strFile)) & " [" & Err.Description & "]"
			Err.Clear
		End If
	Next
	Status "Program finished: " & Now
	Status "*************************************"
	Status "*************************************"
	If Lcase(Right(Wscript.FullName, 11)) = "wscript.exe" Then MsgBox "Program Finished! Details are in the log at " & Wscript.ScriptFullName & ".log", vbOkOnly, "Sub Copy"
End Sub

Function FileNameInThisDir(strFileName) 'As String
'Returns the complete path and file name to a file in
'the script directory. For example, "trans.log" might
'return "C:\Program Files\Scripts\Database\trans.log"
'if the script was in the "C:\Program Files\Scripts\Database"
'directory.
Dim fs 'As Scripting.FileSystemObject
	Set fs = CreateObject("Scripting.FileSystemObject")
	 FileNameInThisDir = fs.GetAbsolutePathName(fs.BuildPath(Wscript.ScriptFullName, "..\" & strFileName))
	''''''''''Clean up
	Set fs = Nothing
End Function

Sub Status (strMessage)
'If the program was run with CSCRIPT, this writes a
'line into the DOS box. If run with WSCRIPT, it writes
'to a log in the same directory as the script.
Dim ts 'As Scripting.TextStream
Dim fs 'As Scripting.FileSystemObject
Const ForAppending = 8 'Scripting.IOMode
	If Lcase(Right(Wscript.FullName, 12)) = "\cscript.exe" Then 
		Wscript.Echo strMessage
		If gblnLog Then
			Set fs = CreateObject("Scripting.FileSystemObject")
			Set ts = fs.OpenTextFile(Wscript.ScriptFullName & ".log", ForAppending, True)
			ts.WriteLine strMessage
			ts.Close
		End If
	Else
		Set fs = CreateObject("Scripting.FileSystemObject")
		Set ts = fs.OpenTextFile(Wscript.ScriptFullName & ".log", ForAppending, True)
		ts.WriteLine strMessage
		ts.Close
	End If
End Sub