vbs 文件操作集

最近遇到一个应用，要求将指定文件夹下的所有 html 文件中包含的某些文字的文件给改名。下面是我写的一个 vbs 文件：

rename.vbs

' 关键字配置文件地址 
Const  config  =   " E:\cleandata\key.txt "

' 要检查的文件夹 
Const  dir  =   " D:\Log\html\ "

' 日志保存路径 
Const  LogDir  =   " E:\cleandata\Log\ "

' 全局对象 
set  fso = createobject ( " scripting.filesystemobject " )  

Dim  keywordList( 10000 )

Rem  : =========== 启动主程序 
Dim  starttime , Endtime

starttime  =   Now  
Call  main()
endtime  =   Now  

Set  fso  =   Nothing  

msgbox    " 恭喜！操作已完成。时间从： "   &  starttime  &   "  到  "   &  endtime   , 4096 , " 文件重命名 "

Rem  :  =========== 主程序
Sub  main()
    wscript.echo  " 开始。。。 "   &   Now  
     Call  GetKeyWord()
     Call  getFiles(dir)
End Sub  

Rem  :  ===========  读取配置文件
Sub  GetKeyWord()
     set  sdir  =   createobject ( " scripting.dictionary " )  
     set  file  =  fso.opentextfile(config)  
     do   while  file.atendofstream <> true   
        m = m + 1   
        sdir.add m,file.readline  
         Dim  word
        word  =  sdir(m)
'         wscript.echo word 
         If   Len ( Trim (word) ) > 0   Then  
            KeywordList(m) =  word
         End   If  
     Loop  
    file.close  
     Set  file  =   Nothing  
End Sub  

Rem  :  =========== 获取文件列表 
Sub  getFiles(path)
     Set  folder  =  fso.GetFolder(path)
     Set  subfolder  =  folder.subfolders
     Set  file  =  folder.files
     For   Each  s_file In file
         ' wscript.echo s_file.path
        checkWord s_file.path
     Next  

     For   Each  s_subfolder In subfolder
        getFiles(s_subfolder.path)     ' 递归调用 
     Next  
End Sub  

Rem  :  ===========  比较配置文件，判断是否包含关键字 
Sub  checkWord(path)
     ' wscript.echo path
     Dim  content , file 
     Set  file  =  fso.opentextfile(path,  1 ,  false ) 
    content  =  file.readall
    file.close
     Set  file  =   Nothing  
     For  i = 0   To   UBound (keywordList)
        word  =  keywordList(i)
         If   InStr (content, word ) > 0   And   Len (word) > 0   Then  
            wscript.echo path  &   "  已匹配到： "   &  word
'             Set file = Nothing 
            RenameSubPage path
             Exit   For  
         End   If  
     Next  
End Sub  

Rem  : =========== 将文件重命名
Sub  RenameSubPage(path)
     If  fso.fileexists(path)  = True   Then  
         Dim  target , ext
        ext  =   " .bak "
        target  =  path  &  ext
         '  ===== 方法一 
        fso.movefile path , target

         '  ===== 方法二 
         ' Set f = fso.getfile( path)
         ' f.name = f.name & ext 
         ' f.close 
         ' Set f = Nothing 

        WriteLog target
     End   If  
End Sub  

Rem  :  ===========  处理日志
Sub  WriteLog(strmsg)
     Dim  logtxt
    logtxt  =  LogDir  &   " dellog- "   &   Year ( Now )  &   " - "   &   Month ( Now )  &   " - "   &   Day ( Now )  &   " .txt "
    
     Dim  f 
     If  fso.fileexists(logtxt)  Then  
         Set  f  =  fso.opentextfile(logtxt,  8  )
     Else
         Set  f  =  fso.opentextfile(logtxt,  2 ,  true )
     End   If  

    f.writeline strmsg 
    f.close 
     Set  f  =   Nothing  
    
     '  ＝＝＝＝＝ 方法2 
'     Set objShell = CreateObject("Wscript.Shell") 
'     cmd = "%comspec% /k echo " & strmsg & " >> " &  logtxt & "  && exit"
'     objShell.Run(cmd) ,vbhide
     '  挂起允许，防止在任务管理器里产生过多的 cmd.exe 进程 ，如果有多个进程，请用 taskkill /f /im cmd.exe   关闭
'     Set objShell = Nothing 

    Wscript.Sleep  5     
End Sub  

key.txt 文件的内容：

关键字一
关键字一

即一行一个关键字 。

这是 VBS 版批量重命名 的一个改良版。

转载于:https://www.cnblogs.com/infozero/archive/2009/12/17/1626408.html