用VBS壓縮ZIP文件

标簽: , ,

有解壓縮當然也有壓縮,代碼不是我寫的,仍然是昨天給我程序那個高手寫的。

Zip "D:\test.iso", "D:\test.zip"
Zip "D:\test", "D:\test.zip"
Msgbox "OK"

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

随機文章:

  1. VBS模拟POST上傳文件
  2. VBS 獲取外網 IP 并發送到指定郵箱
  3. Ubuntu查看系統運行時間
  4. NDS模拟器DSEmu
  5. 将WMI中的DateTime類型轉換成VBS時間

9 條評論 發表在“用VBS壓縮ZIP文件”上

  1. schang說道:

    其實我有一個問題想問啊,你上面的這個解壓縮方法,貌似隻能解壓縮标準的zip文件,如果有點不一樣就不行,能不能擴張一下,實現解壓縮WINRAR這樣的工具解壓大部分壓縮文件啊,比如我有一個文件是xxx.png.z(注:QTP 結果文件裡生成的壓縮圖片的文件),用上面的方法就不行了,用那個winrar的方法,有個限制就是有的機器上可能沒裝,腳本就會報錯。所以求關注解決啊!

  2. Jucyfer.X說道:

    代碼執行起來沒什麼問題,但是會彈出一個很明顯的複制框,這能不能避免呢?換句話說,能不能後台靜默壓縮?

    • eric說道:

      你把第二行的Msgbox “OK”
      删除了就OK

    • wcd說道:

      Folder.CopyHere(
      vItem,
      [ vOptions ]
      )
      其中vItem參數可以是一個文件的完整路徑,也可以是一個FolderItem對象,或者FolderItems集合對象。
      特别要注意的是vItem參數一定要以Variant 類型傳入,否則會沒有任何響應。

      vOptions參數可以設置一些顯示模式,比如設置為4,在解壓縮zip文件時不會顯示進度條。
      —————–
      轉自 http://www.exceloffice.net/archives/1484

  3. 說道:

    看來感覺收益匪淺,感謝博主。有問題想問一下,我用這段代碼去壓縮文件時,發現,當文件夾内部包含一個空文件夾的時候,會有bug提示信息,大概意思是因為該文件夾下包含空文件夾,因此不可以放入壓縮的achive。我也是初學,不知道是自身的緣故還是其他的原因,特此來請教以下。。謝謝。

  4. rhg說道:

    win7執行報錯, Set objFolderItem = objSource.Items(), 缺少對象,800a01a8,所傳入參數:Zip “D:/workspace/db/20141014”, “D:/workspace/db/20141014.zip”

  5. mzy說道:

    請問如何保留文件夾進行壓縮?
    比如
    需要壓縮的文件夾為test,包含1.txt

    壓縮結果為:test.zip,直接打開zip能看到文件夾test,再進入test,才看見1.txt

  6. 天天說道:

    我就是想問,可以實現加密壓縮嘛?

留下回複