将包含文件的文件夹解压缩到所选位置

Question

团队，我正在从 VBA 代码中提取 zip 文件，但出现错误，这是我的代码：

Sub Un_Zip_File()
Dim flname As String
Call PathCall
flname = Dir(impathn & "Transactions*.zip")
Call PathCall
Call UnZip_File(impathn, flname)
End Sub

Sub UnZip_File(strTargetPath As String, fname As Variant)
Dim oApp As Object, FSOobj As Object
Dim FileNameFolder As Variant

If Right(strTargetPath, 1) <> Application.PathSeparator Then
strTargetPath = strTargetPath & Application.PathSeparator
End If

FileNameFolder = strTargetPath

'destination folder if it does not exist
Set FSOobj = CreateObject("Scripting.FilesystemObject")
If FSOobj.FolderExists(FileNameFolder) = False Then
FSOobj.CreateFolder FileNameFolder
End If

Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(fname).Items

Set oApp = Nothing
Set FSOobj = Nothing
Set FileNameFolder = Nothing

End Sub

当我运行 Un_zip_file 宏时，出现错误：

对象变量或未设置块变量

调试后继续

oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(fname).Items

Answer 1

这里是另一个解压文件的例子。
宏解压压缩文件到一个固定文件夹"C:\test\"

Sub Unzip()
    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 Fname = False Then
        'Do nothing
    Else
        'Destination folder
        DefPath = "C:\test\"    ' Change to your path / variable
        If Right(DefPath, 1) <> "\" Then
            DefPath = DefPath & "\"
        End If

        FileNameFolder = DefPath

        '        'Delete all the files in the folder DefPath first if you want
        '        On Error Resume Next
        '        Kill DefPath & "*.*"
        '        On Error GoTo 0

        'Extract the files into the Destination folder
        Set oApp = CreateObject("Shell.Application")
        oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items

        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

Answer 2

在网络上的其他地方找到并认为在这里可能会有所帮助...

Sub UnzipAFile(zippedFileFullName As Variant, unzipToPath As Variant)

Dim ShellApp As Object

'Copy the files & folders from the zip into a folder
Set ShellApp = CreateObject("Shell.Application")
On Error Resume Next
ShellApp.Namespace(unzipToPath).CopyHere ShellApp.Namespace(zippedFileFullName).Items
On Error GoTo 0
End Sub

Answer 3

我有同样的错误“对象变量或未设置块变量”。

通过添加对“Microsoft Shell 控件和自动化”的引用解决了这个问题 - Shell32.dll。然后按此顺序定义和使用 Shell 对象。

不要跳过任何这些步骤。我还在page 中发布了完整代码。

Dim wShApp As Shell

Set wShApp = CreateObject("Shell.Application")
Set objZipItems = wShApp.Namespace(zipFileName).items  

wShApp.Namespace(unZipFolderName).CopyHere objZipItems

Answer 4

为了避免消息错误：

1 - 每个“\”更改“/”

unzipToPath= Replace(unzipToPath, "/", "\\")

zippedFileFullName= Replace(zippedFileFullName, "/", "\\")

2 - 使用双（（到参数如下：

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

Answer 5

我遇到了完全相同的问题，但在 MS Word 中，我试图从 .zip 文件夹中提取文件。经过大量的实验和测试后，我发现后期绑定对象没有正确初始化，当我用 TypeName 函数测试它们时，通常“什么都没有”。

我在 Windows 10 和旧的 Windows XP 机器上测试了我的代码，结果相同。我所有的测试都是在 Excel 2007 和 Excel 2016 中进行的。

将代码从后期绑定更改为早期绑定解决了这个问题。

后期绑定使用 CreateObject 函数来初始化 Shell.Application 库中的对象。早期绑定需要为项目中的“Microsoft Shell 控件和自动化”库设置引用。

要设置参考，请执行以下操作： 在 VBA IDE 中，使用工具菜单打开引用对话框。滚动可用参考列表，直到找到“Microsoft Shell Controls and Automation”条目，然后单击复选框以选择该库，因此： The VBA References dialog, showing the "Microsoft Shell Controls and Automation" library after adding it to your project.