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