VBA直接解压文件（不支持压缩） - 算法函数_API_系统

警告:
本代码不受微软技术支持。当你从一个压缩文件复制文件时会出现一个复制对话筐 (仅在对普通文件夹进行操作时)，而且用户可以取消此复制操作。

提示:
不要定义示例中的 strFileNameFolder 变量为String 类型，必须定义为 Variant 类型，否则代码不能正常运行。

示例 1：
通过此例你可以浏览压缩文件.你选中一个文件后此宏会在你的默认文件路径下创建一个新的文件夹并解压文件到这个文件夹。

Sub UnzipFile()
Dim FSO As Object
Dim oApp As Object
Dim strFileName As Variant
Dim strFileNameFolder As Variant
Dim strDefPath As String
Dim strDate As String
'只支持Zip压缩文件，不支持Rar或其它压缩格式
strFileName = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", MultiSelect:=False)
If Not (strFileName = False)Then
'新文件夹的上级文件夹.
'你也可以支持指定路径 strDefPath = "C:\Users\test"
strDefPath = Application.DefaultFilePath
If Right(strDefPath, 1) <> "" Then
strDefPath = strDefPath & ""
End If
'创建文件夹名称
strDate = Format(Now, " dd-mm-yy h-mm-ss")
strFileNameFolder = strDefPath & "MyUnzipFolder " & strDate & ""
'创建名为 strDefPath 的普通文件夹
MkDir strFileNameFolder
'提取所有文件到此创建的文件夹
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(strFileNameFolder).CopyHere oApp.Namespace(strFileName).items
'假如你只需要提取某一个文件，可以如下:
'oApp.Namespace(strFileNameFolder).CopyHere oApp.Namespace(strFileName).items.Item("test.txt")
MsgBox "文件已经解压到: " & strFileNameFolder
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
'删除临时文件
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End If
End Sub

联系人：	王先生
Email：	18449932@qq.com
QQ：	18449932
微博：	officecn01

联系人：

王先生

Email：

18449932@qq.com

QQ：

18449932

微博：

officecn01