VBA直接解压文件（不支持压缩）

欧非资源网：安全、免费、专业放心的资源下载站！ 最新软件|软件分类

您的位置：欧非资源网 > 其他专区 > Access > VBA直接解压文件（不支持压缩）

VBA直接解压文件（不支持压缩） 时间：2019-11-10 23:23作者：admin来源：未知人气：1169我要评论(0)

提示:
不要定义示例中的 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:Userstest"
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

文章评论

查看所有0条评论>>

分类索引