vbs 文件操作集合代码

vbs 文件操作集合代码

下面是我写的一个 vbs 文件：

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

rem 读取配置文件 Dim config config = "conf.txt" set fso=createobject("scripting.filesystemobject") set a=createobject("scripting.dictionary") set file=fso.opentextfile(config) do while file.atendofstream true m=m+1 a.add m,file.readline src = a(m) RenameSubPage srcloop file.close Set fso =Nothing msgbox "操作已完成" ,4096,"文件重命名"Sub RenameSubPage(strURL) Dim path For i=19 To 100 path = Replace(strURL , ".html", "_" i ".html") If fso.fileexists(path) =True Then target = path ".tmp" fso.movefile path , target Else ' do nothing End If Next End Sub

注释： conf.txt 文件内容如下：
D:\a\b\c.html
D:\d\e\f.html

vbs 文件操作集合代码