一段纯vbs实现zip压缩的代码，无需dll或者winrar支持

[ykdrj]

下面这段是我在网络上找到的纯VBS压缩ZIP的代码，不需要DLL或者是WINRAR或者ZIP软件支持

执行这个脚本的确可以实现纯VB压缩ZIP，但是运行过程中会有个进度条，如何不显示此进度条？

Zip "D:\test.xls", "D:\test.zip" 

Sub Zip(ByVal mySourceDir, ByVal myZipFile) 
Set fso = CreateObject("Scripting.FileSystemObject") 
If fso.GetExtensionName(myZipFile) <> "zip" Then 
Exit Sub 
ElseIf fso.FolderExists(mySourceDir) Then 
FType = "Folder" 
ElseIf fso.FileExists(mySourceDir) Then 
FType = "File" 
FileName = fso.GetFileName(mySourceDir) 
FolderPath = Left(mySourceDir, Len(mySourceDir) - Len(FileName)) 
Else 
Exit Sub 
End If 
Set f = fso.CreateTextFile(myZipFile, True) 
f.Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0)) 
f.Close 
Set objShell = CreateObject("Shell.Application") 
Select Case Ftype 
Case "Folder" 
Set objSource = objShell.NameSpace(mySourceDir) 
Set objFolderItem = objSource.Items() 
Case "File" 
Set objSource = objShell.NameSpace(FolderPath) 
Set objFolderItem = objSource.ParseName(FileName) 
End Select 
Set objTarget = objShell.NameSpace(myZipFile) 
intOptions = 256 
objTarget.CopyHere objFolderItem, intOptions 
Do 
WScript.Sleep 1000 
Loop Until objTarget.Items.Count > 0 
End Sub 

[无·法]

感谢楼主提供这么好的一个压缩文件的方法。
查了下，不现实进度条的话将intOptions = 256 改成intOptions = 4就行了。

具体参考：http://msdn.microsoft.com/en-us/library/ms723207%28VS.85%29.aspx

[ykdrj]

刚刚详细的看了下MSDN上的帮助，并且我将intOptions修改成0或者4都会显示进度条

不知sysdzw是否有其他方法可以隐藏这东西？

[无·法]

测试了下不行，貌似没办法。

下面老外的评论：
flag 4 (Do not display a progress dialog box)
I've used this in a VB-script (vbs) installing fonts and the dialog still shows up.

Progress dialog box
If we specify number 4 for the second parameter, it should not display a progress dialog box. But I've tested (in Windows 7 x64) and doesn't work.
Maybe only doesn't work when copy to a zip file, but I want using it just to zip without a dialog.

http://msdn.microsoft.com/en-us/library/bb787866%28v=VS.85%29.aspx

[思考]

还是调用rar.exe简单

[啊的发哦]

这个挺好，以前我都是内封rar，楼主这个方法不错。

[ykdrj]

是否有大侠可以在我这段脚本将excel压缩成ZIP之前将excel里面的透视表刷新一下

我在中间加了这段，结果报错

Set ExcelApplication = CreateObject("Excel.Application")
Set WB = ExcelApplication.Workbooks.Open(mySourceDir)
ExcelApplication.DisplayAlerts = False
WB.Worksheets("Sheet1").PivotTables("数据透视表1").PivotCache.Refresh
WB.Save
WB.Close
Set WB = Nothing
Set ExcelApplication = Nothing
End Sub

[m60a1]

压缩率如何哈