无需管理员权限即可提取zip内容

时间:2018-01-26 08:31:06

标签: excel vba excel-vba

有没有办法在没有管理员权限的情况下使用VBA提取7z内容?

使用函数UnzipAFile described here我在第0行收到错误:

ShellApp.Namespace(unzipToPath).CopyHere ShellApp.Namespace(zippedFileFullName).items

我认为它与create object命令有关:

Set ShellApp = CreateObject("Shell.Application")

我没有,也没有管理员权限。 (也许是由于其他原因?!?) 谢谢你的帮助。

1 个答案:

答案 0 :(得分:0)

请参阅Ron de Bruin示例代码 -

Unzip file(s) with the default Windows zip program

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 Fname = False Then
        'Do nothing
    Else
        'Root folder for the new folder.
        'You can also use DefPath = "C:\Users\Ron\test\"
        DefPath = Application.DefaultFilePath
        If Right(DefPath, 1) <> "\" Then
            DefPath = DefPath & "\"
        End If

        'Create the folder name
        strDate = Format(Now, " dd-mm-yy h-mm-ss")
        FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"

        'Make the normal folder in DefPath
        MkDir FileNameFolder

        'Extract the files into the newly created folder
        Set oApp = CreateObject("Shell.Application")

        oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items

        'If you want to extract only one file you can use this:
        'oApp.Namespace(FileNameFolder).CopyHere _
         'oApp.Namespace(Fname).items.Item("test.txt")

        MsgBox "You find the files here: " & FileNameFolder

        On Error Resume Next
        Set FSO = CreateObject("scripting.filesystemobject")
        FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
    End If

End Sub