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



vbs文件操作_配置文件

vbs文件操作_javascript_02rename.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 


vbs文件操作_配置文件


key.txt 文件的内容:



关键字一

关键字一


即一行一个关键字 。

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