Option Explicit 'On Error Resume Next 'Does a recursive find and replace operation on all files of specified types 'Written by Eric Phelps http://www.ericphelps.com 'Force "cscript" Dim gintCompareMethod 'As Integer Main Wscript.Quit 0 Sub Main() Dim fil 'As Scripting.File Dim fils 'As Scripting.Files Dim fol 'As Scripting.Folder Dim fols 'As Scripting.Folders Dim fs 'As Scripting.FileSystemObject Dim strDirectories() 'As String Dim strFileTypes 'As String Dim lngCounter 'As Long Dim strOldText 'As String Dim strNewText 'As String Const READONLY = 1 Const HIDDEN = 2 Const SYSTEM = 4 If MsgBox ("This program will do a text search-and-replace on all specified files (Under 1MB in size) in and below a directory you designate. Continue?", vbOkCancel) = vbCancel Then Wscript.Quit Set fs = CreateObject("Scripting.FileSystemObject") If Lcase(Right(Wscript.FullName, 11)) = "wscript.exe" Then If MsgBox ("This program is being run under WSCRIPT. Results will be stored in a log at " & Wscript.ScriptFullName & ".log" & ". Run this program under CSCRIPT if you want a real-time display of activity. Otherwise, a message box will pop up to inform you when the program finishes. Continue?", vbOkCancel, "Search and Replace") = vbCancel Then Wscript.Quit Else If MsgBox ("This program is being run under CSCRIPT. Results will be displayed on-screen and will not be logged. Run this program under WSCRIPT if you want a log file. Continue?", vbOkCancel, "Search and Replace") = vbCancel Then Wscript.Quit End If Redim strDirectories(0) strDirectories(0) = InputBox("Enter path to start swapping text at:", "Search and Replace", FileNameInThisDir("")) If strDirectories(0) = "" Then Wscript.Quit strDirectories(0) = fs.GetAbsolutePathName(strDirectories(0)) gintCompareMethod = MsgBox("Case-sensitive?", vbYesNo) - 6 strOldText = InputBox("Enter the path and file name of a file which contains a sample of the old text you want replaced.", "Old Text File", FileNameInThisDir("old.txt")) If Not fs.FileExists(strOldText) Then MsgBox "The file you specified as containing old text does not exist." Wscript.Quit 1 End If strOldText = fs.OpenTextFile(strOldText,1).ReadAll If strOldText = "" Then MsgBox "The file you specified as containing old text is empty." Wscript.Quit 1 End If strNewText = InputBox("Enter the path and file name of a file which contains a sample of the new text you want to use.", "New Text File", FileNameInThisDir("new.txt")) If Not fs.FileExists(strNewText) Then MsgBox "The file you specified as containing new text does not exist." Wscript.Quit 1 End If strNewText = fs.OpenTextFile(strNewText,1).ReadAll strFileTypes = InputBox("Enter extensions for file types you want to apply this operation to", "File Types", ".txt .htm .html .asp .css .js .vbs .bat .cmd .ini .cpp") If MsgBox("This is your last question. Text replacement starts if you click yes. Okay to replace text in all """ & strFileTypes & """ files in and below the """ & strDirectories(0) & """ directory?", vbYesNo, "Search and Replace") = vbNo Then Wscript.Quit lngCounter = 0 Status "*************************************" Status "*************************************" Status "Program: " & Wscript.ScriptFullName Status "Replacing: " & vbCrLf & "******************" & vbCrLf & strOldText & vbCrLf & "******************" Status "With: " & vbCrLf & "******************" & vbCrLf & strNewText & vbCrLf & "******************" Status "In and Below: " & strDirectories(0) Status "For file types: " & strFileTypes Status "Starting Time: " & Now Do Until lngCounter > Ubound(strDirectories,1) 'Next folder to process Set fol = fs.GetFolder(strDirectories(lngCounter)) 'Get each file in turn Set fils = fol.Files If Err.Number <> 0 Then Exit Sub For Each fil In fils If Instr(fil.Name, ".") <> 0 Then If Instr(1, strFileTypes, Mid(fil.Name, InstrRev(fil.Name, ".")), vbTextCompare) <> 0 Then If Wscript.ScriptFullName <> fil.Path Then If ((fil.Attributes And READONLY) = 0) Then If ((fil.Attributes And SYSTEM) = 0) Then If ((fil.Attributes And HIDDEN) = 0) Then ReplaceText fil, strOldText, strNewText End If End If End If End If End If End If Next 'Check for any sub folders and add them to the folder array Set fols = fol.SubFolders For each fol in fols If Lcase(fol.Name) <> "recycled" Then Redim Preserve strDirectories(Ubound(strDirectories,1) + 1) strDirectories(Ubound(strDirectories,1)) = fol.Path End If Next lngCounter = lngCounter + 1 Loop 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, "Search and Replace" 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 Else Set fs = CreateObject("Scripting.FileSystemObject") Set ts = fs.OpenTextFile(Wscript.ScriptFullName & ".log", ForAppending, True) ts.WriteLine strMessage ts.Close ''''''''''Clean up Set ts = Nothing Set fs = Nothing End If End Sub Sub Force(sScriptEng) 'Forces this script to be run under the desired scripting host 'Valid sScriptEng arguments are "wscript" or "cscript" 'If you don't supply a valid name, Force will switch hosts... If Lcase(Right(Wscript.FullName, 12)) = "\wscript.exe" Then 'Running under WSCRIPT If Instr(1, Wscript.FullName, sScriptEng, 1) = 0 Then 'Need to switch to CSCRIPT CreateObject("Wscript.Shell").Run "cscript.exe " & Wscript.ScriptFullName Wscript.Quit End If Else 'Running under CSCRIPT If Instr(1, Wscript.FullName, sScriptEng, 1) = 0 Then 'Need to switch to WSCRIPT CreateObject("Wscript.Shell").Run "wscript.exe " & Wscript.ScriptFullName Wscript.Quit End If End If End Sub Sub ReplaceText(objScriptingFile, strOldText, strNewText) Dim ts 'As Scripting.TextStream Dim intTries 'As Integer Dim strFileText 'As String Const ForReading = 1 'Scripting.IOMode Const ForWriting = 2 'Scripting.IOMode 'Trying to work with huge strings here causes slowdowns & overflows If objScriptingFile.Size > 999999 Then Status "* TOO LARGE: " & objScriptingFile.Path Exit Sub End If 'Opening executable scripts seems to cause an error first time. Maybe 'due to a delay from the system virus-checker. Good results re-trying! 'Open the file for reading On Error Resume Next For intTries = 0 to 3 Set ts = Nothing Err.Clear Set ts = objScriptingFile.OpenAsTextStream(ForReading) If Err.Number = 0 Then Exit For Wscript.Sleep 50 Next If intTries > 2 Then Status "* CAN'T OPEN: " & objScriptingFile.Path Err.Clear On Error Goto 0 Exit Sub End If 'Read the file For intTries = 0 to 3 Err.Clear strFileText = ts.ReadAll If Err.Number = 0 Then Exit For Wscript.Sleep 50 Next If intTries > 2 Then Status "* CAN'T READ: " & objScriptingFile.Path Err.Clear On Error Goto 0 Exit Sub End If ts.Close 'Replace text If Instr(1, strFileText, strOldText, gintCompareMethod) = 0 Then Exit Sub strFileText = Replace(strFileText, strOldText, strNewText, 1, -1, gintCompareMethod) 'Save changes For intTries = 0 to 3 Err.Clear Set ts = objScriptingFile.OpenAsTextStream(ForWriting) ts.Write strFileText If Err.Number = 0 Then Exit For Wscript.Sleep 50 Next If intTries > 2 Then Status "* CAN'T SAVE: " & objScriptingFile.Path Err.Clear On Error Goto 0 Exit Sub End If Status " MODIFIED: " & objScriptingFile.Path ts.Close On Error goto 0 End Sub