vbs 文件操作集

最近遇到一个应用，要求将指定文件夹下的所有 html 文件中包含的某些文字的文件给改名。下面是我写的一个 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 版批量重命名 的一个改良版。