Откройте ZipFile, найдите определенный тип файла и сохраните имя файла

Question

Итак, я разместил вопрос здесь:

VBA - Найти конкретные подпапки по идентификаторам имен

Этот вопрос был очень широким, но я столкнулся с конкретными проблемами.нужна помощь в определении и решении.Теперь мне удалось решить эти проблемы в исходном сообщении, однако, большая часть вопроса остается без ответа, и я хотел бы закрыть вопрос только тогда, когда смогу опубликовать полный результат.

В настоящее время, что мне еще нужно сделать, это последние 4 шага:

1. Открыть ZipFile
2. Искать расширение .png
3. Захватить имя .pngfile
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

Сообщение об ошибке:

Переменная объекта или Без блока

Всякий раз, когда я пытался использовать 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 - читать .txt из .zip файлов

Я просто не понимаю, почему этот шаг занимает так много времени для завершения.

Answer 1

Ваша основная проблема действительно проста: ваш путь "C:\Users\UserName\Desktop\Today\MyFolder\" уже содержит обратную косую черту, и когда вы устанавливаете переменную ZipFile, вы добавляете еще одну между путем и именем файла.Это приведет к сбою shell -команды и ZipFile равно nothing.

. В коде есть небольшие проблемы.Я бы порекомендовал использовать GetExtensionName вашего FileSystemObject, чтобы получить расширение и преобразовать его в нижний регистр, чтобы вы могли перехватывать все файлы, независимо от того, являются ли они .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))

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