vbs 文件操作集合代码
<p>下面是我写的一个 vbs 文件：</p><p>rename.vbs</p>
<div class="jb51code"><pre class="brush:vb;">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</pre></div>
<p>key.txt 文件的内容：</p>
<blockquote><p>关键字一<br />关键字一</p></blockquote>
<p>即一行一个关键字 。</p>
<p>这是 VBS 版批量重命名 的一个改良版。</p>
<div class="jb51code"><pre class="brush:vb;"> 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 </pre></div>
<p>注释： conf.txt 文件内容如下：<br />D:\a\b\c.html<br />D:\d\e\f.html</p>
頁:
[1]