时间戳

首页 > 解决方案 > 打开 ZipFile，查找特定文件类型并保存文件名

excel - 打开 ZipFile，查找特定文件类型并保存文件名

问题描述

所以我在这里发布了一个问题：

VBA - 按名称标识符查找特定的子文件夹

这个问题非常广泛，但我面临着需要帮助识别和解决的具体问题。现在，我设法在原始帖子中解决了这些问题，但是，仍有很大一部分问题没有得到解答，我只想在能够发布完整结果时关闭问题。

目前，我仍然需要做的是最后 4 个步骤：

  1. 打开压缩文件
  2. 寻找 .png 扩展名
  3. 获取 .png 文件的名称
  4. 将姓名放在excel的单元格中

我面临的问题是正确打开 zip 文件。我在这方面经历了很多帖子，但似乎没有什么对我有用。

我最接近完成任务的是我在这里找到的：

https://www.ozgrid.com/forum/forum/help-forums/excel-general/109333-how-to-count-number-of-items-in-zip-file-with-vba-2007

我想，如果至少我能够输入 zip 文件，我就可以从那里开始工作。但是，唉，我仍然坚持只是试图打开文件。

这是我拥有的代码（使用上面的链接）：

Sub CountZipContents()

    Dim zCount As Double, CountContents As Double
    Dim sh As Object, fld As Object, n As Object
    Dim FSO As Object

    CountContents = 0
    zCount = 0

    x = "C:\Users\UserName\Desktop\Today\MyFolder\"

    Set FSO = CreateObject("Scripting.FileSystemObject")

    If FSO.FolderExists(x) Then

        For Each FileInFolder In FSO.GetFolder(x).Files

            If Right(FileInFolder.Name, 4) = ".png" Then

                CountContents = CountContents + 1

            ElseIf Right(FileInFolder.Name, 4) = ".Zip" Then

                Set sh = CreateObject("Shell.Application")
                Set ZipFile = sh.Namespace(CVar(x & "\" & FileInFolder.Name))

                Debug.Print FileInFolder.Name

                For Each fileInZip In ZipFile.Items

                    If LCase(fileInZip) Like LCase("*.png") Then

                        CountContents = CountContents + 1

                    End If

                Next

            End If

        Next FileInFolder

    End If

    Set sh = Nothing

End Sub

我得到的问题是在这一行：

For Each fileInZip In ZipFile.Items

错误信息：

未设置对象变量或 With 块

每当我尝试使用Shell时，如下所示：

Dim oShell As New Shell

我收到此错误：

未定义用户定义类型

使用以下内容：

链接https://msdn.microsoft.com/en-us/library/windows/desktop/bb776890(v=vs.85).aspx

Dim oApp As Object

Set oApp = CreateObject("WScript.Shell")

'get a shell object
Set oApp = CreateObject("Shell.Application")

If oApp.Namespace(ZipFile).Items.count > 0 Then

我收到此错误：

对象不支持此属性或方法

在这条线上：

If oApp.Namespace(ZipFile).Items.count > 0 Then

对我尝试过的链接的引用：

https://wellsr.com/vba/2015/tutorials/open-and-close-file-with-VBA-Shell/ http://www.vbaexpress.com/forum/showthread.php?38616-quot-shell- quot-not-work-in-Excel Excel VBA - 从 .zip 文件中读取 .txt

我只是不明白为什么这一步要花这么多时间才能完成。

标签： excelvba

解决方案

您的主要问题是一个非常简单的问题：您的路径"C:\Users\UserName\Desktop\Today\MyFolder\"已经包含一个尾随反斜杠，并且当您设置ZipFile-variable 时，您将在路径和文件名之间添加另一个。这将导致shell-command 失败并且ZipFile是nothing.

代码有一些小问题。我建议使用GetExtensionNameFileSystemObject 获取扩展名并将其转换为小写，以便捕获所有文件，无论它们是.PNG，.png还是.Png 

   For Each FileInFolder In FSO.GetFolder(x).Files
        Dim fileExt As String
        fileExt = LCase(FSO.GetExtensionName(FileInFolder.Name))

        If fileExt = "png" Then
            CountContents = CountContents + 1
            Debug.Print "unzipped " & FileInFolder.Name
        ElseIf fileExt = "zip" Then

            Dim ZipFileName As String, ZipFile, fileInZip
            Set sh = CreateObject("Shell.Application")
            ZipFileName = x & FileInFolder.Name
            Set ZipFile = sh.Namespace(CVar(ZipFileName))

            For Each fileInZip In ZipFile.Items
                If LCase(FSO.GetExtensionName(fileInZip)) = "png" Then
                    CountContents = CountContents + 1
                    Debug.Print "zipped in " & FileInFolder.Name & ": " & fileInZip
                End If
            Next
        End If
    Next FileInFolder

此外，强烈建议使用Option Explicit和定义所有变量。并将命令拆分成更小的部分。这只需花费您几秒钟的时间输入额外的行，但在调试代码时会有所帮助：

' Instead of
' Set ZipFile = sh.Namespace(CVar(x & "\" & FileInFolder.Name)) 
' write
Dim fName as string
fName = x & "\" & FileInFolder.Name; ' Now you can check fName and see the problem.
Set ZipFile = sh.Namespace(CVar(fName))

推荐阅读