vba 将包含文件的文件夹解压缩到所选位置
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/35717193/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Unzip folder with files to the chosen location
提问by Dharmendra
Team, I am working upon extract the zip file from VBA code but getting error, here is my code:
团队，我正在从 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
When I am running Un_zip_file macro, I am getting error:
当我运行 Un_zip_file 宏时，出现错误：
Object variables or with block variable not set
对象变量或未设置块变量
after debug moving on
调试后继续
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(fname).Items
回答by XsiSec
Here is another example how to unzip a file.
the macro unzip the zip file in a fixed folder"C:\test\"
这是另一个如何解压缩文件的示例。
宏将 zip 文件解压缩到固定文件夹中"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
回答by Stickman68
Found elsewhere on the web and thought it might help here...
在网络上的其他地方找到并认为它可能对这里有帮助......
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
回答by Kumarapush
I had same error "Object variables or with block variable not set".
我有同样的错误“对象变量或块变量未设置”。
Solved it by adding reference to "Microsoft Shell Controls & Automation" - Shell32.dll. Then define & use the Shell object in this order.
通过添加对“Microsoft Shell 控件和自动化” - Shell32.dll 的引用解决了该问题。然后按此顺序定义和使用 Shell 对象。
Do not skip any of these steps. I have also posted full code in this page.
不要跳过任何这些步骤。我还在这个页面上发布了完整的代码。
Dim wShApp As Shell
Set wShApp = CreateObject("Shell.Application")
Set objZipItems = wShApp.Namespace(zipFileName).items
wShApp.Namespace(unZipFolderName).CopyHere objZipItems
回答by Matthew Harris
I had exactly the same problem, but in MS Word, trying to extract files from a .zip folder. After a lot of experimentation and testing I discovered that the late-binding objects were not initializing correctly, and when i tested them with the TypeName function were typically "nothing".
我遇到了完全相同的问题，但在 MS Word 中，尝试从 .zip 文件夹中提取文件。经过大量实验和测试后，我发现后期绑定对象没有正确初始化，当我使用 TypeName 函数测试它们时，它们通常“没有”。
I tested my code in both Windows 10 and on an old Windows XP machine, with the same results. All my testing was in Excel 2007 and Excel 2016.
我在 Windows 10 和旧的 Windows XP 机器上测试了我的代码，结果相同。我所有的测试都是在 Excel 2007 和 Excel 2016 中进行的。
Changing the code from late-binding to early-binding resolved the problem.
将代码从后期绑定更改为早期绑定解决了问题。
Late-binding uses the CreateObject function to initialize the objects in the Shell.Application library. Early-binding requires setting a referenceto the "Microsoft Shell Controls and Automation" library in your project.
后期绑定使用 CreateObject 函数来初始化 Shell.Application 库中的对象。早期绑定需要在您的项目中设置对“Microsoft Shell 控件和自动化”库的引用。
To set the reference, do this: In the VBA IDE, use the Tools menu to open the References dialog. Scroll through the list of available references until you find the "Microsoft Shell Controls and Automation" entry, and then click the checkbox to select that library, thus: The VBA References dialog, showing the "Microsoft Shell Controls and Automation" library after adding it to your project.
要设置引用，请执行以下操作： 在 VBA IDE 中，使用“工具”菜单打开“引用”对话框。滚动可用引用列表，直到找到“Microsoft Shell 控件和自动化”条目，然后单击复选框以选择该库，因此： VBA 引用对话框，添加后显示“Microsoft Shell 控件和自动化”库到您的项目。
