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