当前位置:萝卜系统下载站 > 办公软件教程 > 详细页面

VBA直接解压文件(不支持压缩)

VBA直接解压文件(不支持压缩)

更新时间:2023-07-05 文章作者:未知 信息来源:网络 阅读次数:

Microsoft Office Access是由微软发布的关系数据库管理系统。它结合了 MicrosoftJet Database Engine 和 图形用户界面两项特点,是 Microsoft Office 的系统程序之一。Microsoft Office Access是微软把数据库引擎的图形用户界面和软件开发工具结合在一起的一个数据库管理系统。它是微软OFFICE的一个成员, 在包括专业版和更高版本的office版本里面被单独出售。2018年9月25日,最新的微软Office Access 2019在微软Office 2019里发布。

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


Microsoft Access在很多地方得到广泛使用,例如小型企业,大公司的部门。

温馨提示:喜欢本站的话,请收藏一下本站!

本类教程下载

系统下载排行

网站地图xml | 网站地图html