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

为了解决这类问题，我使用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

一种更加巧妙的方法
对上个脚本稍加改动，使用正则表达式（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