Sub Unzip1_one_file()
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", MultiSelect:=False)
If Not (Fname = False) Then
'新文件夹的上级文件夹.
'你也可以支持指定路径 DefPath = "C:\Users\Ron\test\"
DefPath = "C:\Users\EJJOLLI\Desktop\file\"
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
'创建文件夹名称
'选择
Sub Unzip1_one_file()
Dim x, y
x = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", MultiSelect:=True)
If VBA.IsArray(x) Then
For Each y In x
Call test2(y)
Next
ElseIf x <> False Then
Call test2(y)
End If
End Sub
'解压
Sub test2(f)
Dim oApp As Object
Dim fld As Variant
Dim p As String
'新文件夹的上级文件夹.
'你也可以支持指定路径 p = "C:\Users\Ron\test\"
p = "d:\abc"
If Right(p, 1) <> "\" Then p = p & "\"
'创建文件夹名称
fld = p & Range("B4")
'提取所有文件到此创建的文件夹
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(fld).CopyHere oApp.Namespace(f).items