使用脚本自动压缩指定目标下的所有文件的代码

有的时候，需要对一个目录下所有的某种类型文章进行压缩（例如WORD文档、MP3等）。如果使用手工，则数量少的时候还可以。如果多的话，则不胜其 为了解决这类问题，我使用Visual Basic Scripting设计了一个脚本，可以自动达到这个目标。在本脚本中，自动压缩所有文件。为了避免将脚本自己也压缩进去，使用了一些判断。 复制代码 代码如下: call main() Sub main() Dim fs '文件系统。 Dim f 'folder Dim fc 'files Dim s 'string Dim ws 'SHELL。 Dim subfs Dim fi '创建SHELL。 Set ws = CreateObject("WScript.Shell") '创建文件对象。 Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(ws.currentdirectory) Handle_files(ws.currentdirectory) Set subfs = f.SubFolders '遍历每个子目录。 For Each fi In subfs Call ListSub(fi.Path) Next End Sub Sub ListSub(filename) On Error Resume Next Dim subfs '子目录。 '首先处理当前目录。 Handle_Files(filename) '创建文件对象。 Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(filename) Set subfs = f.SubFolders For Each fi In subfs Call ListSub(fi.Path) Next End Sub '处理每个目录下的文件。 Sub Handle_Files(foldername) '创建文件对象。 Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(foldername) Set fc = f.Files '创建SHELL。 Set ws = CreateObject("WScript.Shell") '遍历文件对象。 For Each fl In fc if ((instr(fl.Name,"vbs") = 0) and (instr(fl.Name,"rar") = 0)) then '进行压缩。 s = "winrar M -ep " & fl.Path & ".rar " & fl.Path ws.Run s, 0, True End If Next End Sub sub output(string) wscript.echo string end sub www.iniot.cn 一种更加巧妙的方法 对上个脚本稍加改动，使用正则表达式（Regular Expression ），可以方便我们的判断过程。修改后的脚本程序如下所示。注意我们这里排除的是不压缩的文件类型。 复制代码 代码如下: call main() Sub main() Dim fs '文件系统。 Dim f 'folder Dim fc 'files Dim s 'string Dim ws 'SHELL。 Dim subfs Dim fi '创建SHELL。 Set ws = CreateObject("WScript.Shell") '创建文件对象。 Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(ws.currentdirectory) Handle_files(ws.currentdirectory) Set subfs = f.SubFolders '遍历每个子目录。 For Each fi In subfs Call ListSub(fi.Path) Next End Sub Sub ListSub(filename) On Error Resume Next Dim subfs '子目录。 '首先处理当前目录。 Handle_Files(filename) '创建文件对象。 Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(filename) Set subfs = f.SubFolders For Each fi In subfs Call ListSub(fi.Path) Next End Sub '处理每个目录下的文件。 Sub Handle_Files(foldername) '创建文件对象。 Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(foldername) Set fc = f.Files '创建SHELL。 Set ws = CreateObject("WScript.Shell") '遍历文件对象。 For Each fl In fc if ( RegExpTest(".vbs|.rar|.zip",fl.name) = false) then '进行压缩。 s = "winrar M -ep " & fl.Path & ".rar " & fl.Path output s ws.Run s, 0, True End If Next End Sub sub output(string) wscript.echo string end sub '使用正则表达式进行判断。 Function RegExpTest(patrn, strng) Dim regEx, retVal ' Create variable. Set regEx = New RegExp ' Create regular expression. regEx.Pattern = patrn ' Set pattern. regEx.IgnoreCase = False ' Set case sensitivity. retVal = regEx.Test(strng) ' Execute the search test. If retVal Then RegExpTest = true Else RegExpTest = false End If End Function