Access开发培训
网站公告
·Access专家课堂QQ群号:151711184    ·Access快速开发平台下载地址及教程    ·欢迎加入Access专家课堂微信群!    ·如何快速搜索本站文章|示例|资料    
您的位置: 首页 > 技术文章 > Access数据库-模块/函数/VBA

VBA直接解压/压缩文件

时 间:2013-12-20 20:53:33
作 者:爱在深秋   ID:1294  城市:厦门
摘 要:解压 压缩 文件
正 文:

本文部分译自网络。


警告:

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

提示:

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

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



Sub Unzip1()

    Dim FSO As Object
    Dim oApp As Object
    Dim Fname As Variant
    Dim FileNameFolder As Variant
    Dim DefPath As String
    Dim strDate As String
    Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", MultiSelect:=False)

    If Not (Fname = False)Then

        '新文件夹的上级文件夹.
        '你也可以支持指定路径 DefPath = "C:\Users\Ron\test\"
        DefPath = Application.DefaultFilePath
        If Right(DefPath, 1) <> "\" Then
            DefPath = DefPath & "\"
        End If
        '创建文件夹名称
        strDate = Format(Now, " dd-mm-yy h-mm-ss")
        FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"
        '创建名为 DefPath 的普通文件夹
        MkDir FileNameFolder
        '提取所有文件到此创建的文件夹
        Set oApp = CreateObject("Shell.Application")
        oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
        '假如你只需要提取某一个文件,可以如下:
        'oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items.Item("test.txt")
        MsgBox "文件已经解压到: " & FileNameFolder
        On Error Resume Next
        Set FSO = CreateObject("scripting.filesystemobject")
        '删除临时文件
        FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True

    End If

End Sub

Access软件网官方交流QQ群 (群号:54525238)       Access源码网店

常见问答:

技术分类:

相关资源:

专栏作家

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助