VBA脚本解压缩文件 - 它只是创建空文件夹 [英] VBA script to Unzip Files - It's Just Creating Empty Folders

问题描述

我正在使用Ron的代码（ http://www.rondebruin.nl /win/s7/win002.htm ），理论上解压缩一堆zip文件在一个文件夹中。我相信我下面的代码是将我的'Downloads'目录中的每个zip文件的代码，创建一个没有.zip的zip文件名的新文件夹，然后将文件提取到新文件夹中。我没有得到任何错误（很多人得到运行时错误91），但唯一的事情是它创建一堆正确命名的文件夹，但都是空的。

作为字符串，str_DESTINATION作为字符串

'您的目录中的zip文件被保留
str_DIRECTORY =C：\Users\Jennifer\Downloads\

'循环给定目录中的所有zip文件
str_FILENAME = Dir（str_DIRECTORY &* .zip）

Do While Len（str_FILENAME）> 0
调用Unzip1（str_DIRECTORY& str_FILENAME）
Debug.Print str_FILENAME
str_FILENAME =目录
循环

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）& \

如果Fname = False然后
'不执行任何
Else
'在根文件夹中创建新文件夹
MkDir FnameTrunc

'将文件解压缩到新创建的文件夹
设置oApp = CreateObject（Shell.Application）
oApp.Namespace（FnameTrunc）.CopyHere oApp.Namespace（Fname）.items
End If
End Sub

解决方案

问题是你没有给Windows足够的时间来提取zip文件。添加 DoEvents ，如下所示。

TRIED AND TESTED

  oApp.Namespace（FnameTrunc）.CopyHere oApp.Namespace（Fname）.items 
 DoEvents 
  

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.

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

解决方案

The problem is you are not giving windows enough time to extract the zip file. Add DoEvents after the line as shown below.

TRIED AND TESTED

    oApp.Namespace(FnameTrunc).CopyHere oApp.Namespace(Fname).items
    DoEvents

这篇关于VBA脚本解压缩文件 - 它只是创建空文件夹的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！