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 版批量重命名的一个改良版。