解压缩文件的 VBA 脚本 - 只是创建空文件夹
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/19809056/
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
VBA script to Unzip Files - It's Just Creating Empty Folders
提问by Jennifer Williams
I'm using the code by Ron (http://www.rondebruin.nl/win/s7/win002.htm) to, in theory, unzip a bunch of zip files in a folder. I believe what I have below is the code that takes each zip file in my 'Downloads' directory, creates a new folder with the name of the zip file without the ".zip", and then extracts the files into the new folder. I am not getting any errors (many times people get the runtime error 91) but the only thing that happens is that it creates a bunch of correctly named folders but they are all empty.
我正在使用 Ron ( http://www.rondebruin.nl/win/s7/win002.htm)的代码，从理论上讲，将一堆 zip 文件解压缩到一个文件夹中。我相信我下面的代码是在我的“下载”目录中获取每个 zip 文件，使用不带“.zip”的 zip 文件的名称创建一个新文件夹，然后将文件解压缩到新文件夹中。我没有收到任何错误（很多时候人们收到运行时错误 91），但唯一发生的事情是它创建了一堆正确命名的文件夹，但它们都是空的。
Sub UnZipMe()
Dim str_FILENAME As String, str_DIRECTORY As String, str_DESTINATION As String
'Your directory where zip file is kept
str_DIRECTORY = "C:\Users\Jennifer\Downloads\"
'Loop through all zip files in a given directory
str_FILENAME = Dir(str_DIRECTORY & "*.zip")
Do While Len(str_FILENAME) > 0
Call Unzip1(str_DIRECTORY & str_FILENAME)
Debug.Print str_FILENAME
str_FILENAME = Dir
Loop
End Sub
Sub Unzip1(str_FILENAME As String)
Dim oApp As Object
Dim Fname As Variant
Dim FnameTrunc As Variant
Dim FnameLength As Long
Fname = str_FILENAME
FnameLength = Len(Fname)
FnameTrunc = Left(Fname, FnameLength - 4) & "\"
If Fname = False Then
'Do nothing
Else
'Make the new folder in root folder
MkDir FnameTrunc
'Extract the files into the newly created folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FnameTrunc).CopyHere oApp.Namespace(Fname).items
End If
End Sub
回答by Siddharth Rout
The problem is you are not giving windows enough time to extract the zip file. Add DoEventsafter the line as shown below.
问题是您没有给 Windows 足够的时间来提取 zip 文件。DoEvents在如下所示的行之后添加。
TRIED AND TESTED
久经考验
oApp.Namespace(FnameTrunc).CopyHere oApp.Namespace(Fname).items
DoEvents
