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