用VBS解压缩ZIP文件

用VBS解压ZIP文件，网上搜到的多数是调用WinRAR，一点技术含量也没有。Google一下“VBS 解压ZIP”，第二是搜搜问问“vbs实现解压缩zip文件”，满意答案是“所以想用vbs来解压这两种格式的文件，至少要有两种命令行解压工具，否则是绝对不可以的”。绝对不可以的，回答的人好自信啊，笑而不语~

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

Sub CopyFolder(ByVal mySourceDir, ByVal myTargetDir)
    Set fso = CreateObject("Scripting.FileSystemObject")
    If NOT fso.FolderExists(mySourceDir) Then
        Exit Sub
    ElseIf NOT fso.FolderExists(myTargetDir) Then
        fso.CreateFolder(myTargetDir)
    End If
    Set objShell = CreateObject("Shell.Application")
    Set objSource = objShell.NameSpace(mySourceDir)
    Set objFolderItem = objSource.Items()
    Set objTarget = objShell.NameSpace(myTargetDir)
    intOptions = 256
    objTarget.CopyHere objFolderItem, intOptions
End Sub

2012年1月3日更新（时隔一年多之后）：很多朋友都提到没有UnZip函数，这的确是我当时疏忽贴错了代码，搞笑的是垃圾脚本之家把错误的代码也一并抄袭了过去，然后又有垃圾网站采集垃圾脚本之家，于是网上的代码全部都是错误的。

下面是正确的UnZip函数，不过那些垃圾站没有机会采集到了：

Sub UnZip(ByVal myZipFile, ByVal myTargetDir)
    Set fso = CreateObject("Scripting.FileSystemObject")
    If NOT fso.FileExists(myZipFile) Then
        Exit Sub
    ElseIf fso.GetExtensionName(myZipFile) <> "zip" Then
        Exit Sub
    ElseIf NOT fso.FolderExists(myTargetDir) Then
        fso.CreateFolder(myTargetDir)
    End If
    Set objShell = CreateObject("Shell.Application")
    Set objSource = objShell.NameSpace(myZipFile)
    Set objFolderItem = objSource.Items()
    Set objTarget = objShell.NameSpace(myTargetDir)
    intOptions = 256
    objTarget.CopyHere objFolderItem, intOptions
End Sub

随机文章:

1. 那些长的像UTF-8的GBK编码
2. jQuery设置ajax请求中的User-Agent
3. VBS For Next循环的一些细节
4. VBS实现UTF-8转Unicode(UTF-16)
5. NTFS文件流

这篇文章发布于 2010年12月13日，星期一，22:42，归类于 程序设计。 您可以跟踪这篇文章的评论通过 RSS 2.0 feed。 您可以留下评论，或者从您的站点trackback。