vbs 文件操作集合代码
作者:感恩的心
最近遇到一个应用,要求将指定文件夹下的所有 html 文件中包含的某些文字的文件给改名
下面是我写的一个 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 , 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 版批量重命名 的一个改良版。
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 src loop 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 文件操作集合代码的文章就介绍到这了,更多相关vbs 文件操作内容请搜索脚本之家以前的文章或继续浏览下面的相关文章希望大家以后多多支持脚本之家!