 
call main() 
Sub main() 
Dim fs '文件系統(tǒng)。 
Dim f 'folder 
Dim fc 'files 
Dim s 'string 
Dim ws 'SHELL。 
Dim subfs 
Dim fi 
'創(chuàng)建SHELL。 
Set ws = CreateObject("WScript.Shell") 
'創(chuàng)建文件對象。 
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 '子目錄。 
'首先處理當(dāng)前目錄。 
Handle_Files(filename) 
'創(chuàng)建文件對象。 
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) 
'創(chuàng)建文件對象。 
Set fs = CreateObject("Scripting.FileSystemObject") 
Set f = fs.GetFolder(foldername) 
Set fc = f.Files 
'創(chuàng)建SHELL。 
Set ws = CreateObject("WScript.Shell") 
'遍歷文件對象。 
For Each fl In fc 
if ((instr(fl.Name,"vbs") = 0) and (instr(fl.Name,"rar") = 0)) then 
'進(jìn)行壓縮。 
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 

一種更加巧妙的方法
對上個腳本稍加改動，使用正則表達(dá)式（Regular Expression ），可以方便我們的判斷過程。修改后的腳本程序如下所示。注意我們這里排除的是不壓縮的文件類型。

復(fù)制代碼代碼如下:

 
call main() 
Sub main() 
Dim fs '文件系統(tǒng)。 
Dim f 'folder 
Dim fc 'files 
Dim s 'string 
Dim ws 'SHELL。 
Dim subfs 
Dim fi 
'創(chuàng)建SHELL。 
Set ws = CreateObject("WScript.Shell") 
'創(chuàng)建文件對象。 
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 '子目錄。 
'首先處理當(dāng)前目錄。 
Handle_Files(filename) 
'創(chuàng)建文件對象。 
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) 
'創(chuàng)建文件對象。 
Set fs = CreateObject("Scripting.FileSystemObject") 
Set f = fs.GetFolder(foldername) 
Set fc = f.Files 
'創(chuàng)建SHELL。 
Set ws = CreateObject("WScript.Shell") 
'遍歷文件對象。 
For Each fl In fc 
if ( RegExpTest(".vbs|.rar|.zip",fl.name) = false) then 
'進(jìn)行壓縮。 
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 
'使用正則表達(dá)式進(jìn)行判斷。 
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 