'On Error Resume Next 'Recursively replaces four spaces with a single tab on all 'specified files. Written by Eric Phelps http://www.ericphelps.com Option Explicit 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 replace all instances of four spaces with a single tab character in 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 spaces for tabs:", "Search and Replace", FileNameInThisDir("")) If strDirectories(0) = "" Then Wscript.Quit strDirectories(0) = fs.GetAbsolutePathName(strDirectories(0)) strOldText = String(4, " ") strNewText = vbTab strFileTypes = InputBox("Enter extensions for file types you want to apply this operation to", "File Types", ".txt .vbs .js .snippet") If MsgBox("Ready to replace spaces with tabs 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:......" & strOldText Status "With:..........." & strNewText 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 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(strFileText, strOldText) = 0 Then Exit Sub Do While Instr(strFileText, strOldText) <> 0 strFileText = Replace(strFileText, strOldText, strNewText) Loop '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