批量文件查找替换功能的vbs脚本

用vbs实现的批量文件的替换

 

'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ 
'code by lcx 修改网上原有的一个小程序，不知作者，那个程序没有对目录实现递归查找 
'将本程序放在你要查找的目录下，或把查找的目录拖到此脚本上，估计还有bug 
'======================================================================================= 
On Error Resume next 
Do Until False 
        Findstr=InputBox("请输入你要查找的字符(串):", "请输入") 
        If Findstr <> "" Then 
                Exit do 
        End If 
Loop 

repwith=InputBox("请输入你要替换的字符(串):，如果留空则只为查找", "请输入") 


If Wscript.Arguments.Count <> 0 Then 
        For i=0 To WScript.Arguments.Count-1 
                folderpath=WScript.Arguments(i) 
                find(folderpath) 
        Next 
Else 
        '处理当前目录 
        Set objShell = CreateObject("WScript.Shell") 
        folderpath=objShell.CurrentDirectory 
        find(folderpath) 
End If 

'替换主程序 
Sub find(path) 
        set fso=CreateObject("Scripting.FileSystemObject") 
        set current=fso.GetFolder(path) 
        For Each file In current.Files 

                        set fsofile=fso.OpenTextFile(file, 1, true) 
       On Error Resume next 
                        tempstr=fsofile.Readall 

       If InstrRev(tempstr,Findstr, -1, 0)<>0 And repwith = "" Then  
       with Fso.opentextfile(left(Wscript.ScriptFullName,len(Wscript.ScriptFullName)-len(Wscript.ScriptName))&"/re.txt",8,true) 
                        .writeline file 
       .close 
       end with 
       End If 

       If repwith <> "" Then 
       tempstr=replace(tempstr, Findstr, repwith) 
       set fsofile1=fso.OpenTextFile(file, 2, true) 
                        fsofile1.WriteLine tempstr 
       fsofile.close 
       End if 

                        
        Next 

   for each folder in current.subfolders  
   Call find(folder.path) 
   next 

set fso=nothing 
End Sub 

msgbox "OK,查找的文件名保存在re.txt"