Question

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

VBA - Find Specific Sub Folders by Name Identifiers

这个问题涉及面很广，但是我遇到的特定问题需要我帮助确定和解决。现在，我设法在原始帖子中解决了这些问题，但是，仍然有很大一部分问题没有得到回答，我只想在能够发布完整结果后才结束该问题。

当前，我仍然需要做的最后四步：

打开ZipFile
寻找.png扩展
获取.png文件的名称
将名称放在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文件，然后从那里开始工作。但是，a，我仍然只是尝试打开文件而已。

这是我的代码（通过上面的链接使用）：

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 - read .txt from .zip files

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

Answer 1

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

代码有一些小问题。我建议使用FileSystemObject的GetExtensionName来获取扩展名并将其转换为小写字母，以便捕获所有文件，无论它们是.PNG，.png还是{{1 }}

.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

Answer 2

尝试一下：

Option Explicit

' Just to test CheckZipFolder
Sub TestZip()

    Dim sZipFold As String: sZipFold = "C:\Temp\MyZip.zip"      ' Change this to the path to your zip file
    CheckZipFolder sZipFold

End Sub


Sub CheckZipFolder(ByVal sZipFold As String)

    Dim oSh As New Shell        ' For this, you need to add reference to 'Microsoft Shell Controls and Automation'
    Dim oFi As Object

    ' Loop through all files in the folder
    For Each oFi In oSh.Namespace(sZipFold).Items

        ' Checking for file type (excel file in this case)
        If oFi.Type = "Microsoft Excel Worksheet" Then
            MsgBox oFi.Name
            '..... Add your actions here
        End If

        ' This will make the UDF recursive. Remove this code if not needed
        If oFi.IsFolder Then
            CheckZipFolder oFi.Path
        End If
    Next

    ' Clear object
    Set oSh = Nothing

End Sub

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

2 个答案: