Разархивируйте в VBA и переименуйте выходной файл в имя zip-файла

Я уже искал решение, но так и не нашел. Я просто хочу разархивировать файл и затем переименовать вывод в имя zip-файла (например, myfile.zip ---> myfile.xls). Мои zip-файлы содержат только один файл xls. Этот код почти делает то, что я хочу, но я получаю только пустой файл myfile.xls (0 КБ) в tempFolder:

Shell "cmd /c " & pathTo7zip & " e """ & file & """ -so > """ & tempFolder & Replace(Mid(file, InStrRev(file, "\") + 1), ".zip", ".xls") & """"

Я был бы очень признателен за любую помощь. Решение не обязательно должно быть основано на 7-zip, возможно, есть другое решение на базе Windows.

Что произойдет, если убрать cmd /c?

GSerg 20.06.2024 02:06

ок.. теперь пишет "файл не найден"... возможно, я приближаюсь :-)

cody 20.06.2024 02:09

У вас уже есть pathTo7zip в двойных кавычках?

GSerg 20.06.2024 02:10

нет, без... Я только что отрезал это в начале: "cmd /c" &

cody 20.06.2024 02:12

Теперь, когда у вас есть, заключите pathTo7zip в двойные кавычки, как и другие пути.

GSerg 20.06.2024 02:13

Та же ошибка - "файл не найден"... вы изначально это имели в виду, да? Оболочка «pathTo7zip» и «e

cody 20.06.2024 02:16

Нет, я имею в виду, как и у вас file.

GSerg 20.06.2024 02:17

Давайте продолжим обсуждение в чате.

cody 20.06.2024 02:18

Не могли бы вы написать мне начало этой строки? Это было бы здорово... Я не совсем понимаю, что вы имеете в виду.

cody 20.06.2024 02:29
Стоит ли изучать PHP в 2026-2027 годах?
Стоит ли изучать PHP в 2026-2027 годах?
Привет всем, сегодня я хочу высказать свои соображения по поводу вопроса, который я уже много раз получал в своем сообществе: "Стоит ли изучать PHP в...
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
В JavaScript одним из самых запутанных понятий является поведение ключевого слова "this" в стрелочной и обычной функциях.
Приемы CSS-макетирования - floats и Flexbox
Приемы CSS-макетирования - floats и Flexbox
Здравствуйте, друзья-студенты! Готовы совершенствовать свои навыки веб-дизайна? Сегодня в нашем путешествии мы рассмотрим приемы CSS-верстки - в...
Тестирование функциональных ngrx-эффектов в Angular 16 с помощью Jest
В системе управления состояниями ngrx, совместимой с Angular 16, появились функциональные эффекты. Это здорово и делает код определенно легче для...
Концепция локализации и ее применение в приложениях React ⚡️
Концепция локализации и ее применение в приложениях React ⚡️
Локализация - это процесс адаптации приложения к различным языкам и культурным требованиям. Это позволяет пользователям получить опыт, соответствующий...
Пользовательский скаляр GraphQL
Пользовательский скаляр GraphQL
Листовые узлы системы типов GraphQL называются скалярами. Достигнув скалярного типа, невозможно спуститься дальше по иерархии типов. Скалярный тип...
0
9
60
2
Перейти к ответу Данный вопрос помечен как решенный

Ответы 2

Ответ принят как подходящий

Вы можете использовать мою функцию UnZip, а затем переименовать извлеченный файл:

' Unzip files from a zip file to a folder using Windows Explorer.
' Default behaviour is similar to right-clicking a file/folder and selecting:
'   Unpack all ...
'
' Parameters:
'   Path:
'       Valid (UNC) path to a valid zip file. Extension can be another than "zip".
'   Destination:
'       (Optional) Valid (UNC) path to the destination folder.
'   Overwrite:
'       (Optional) Leave (default) or overwrite an existing folder.
'       If False, an existing folder will keep other files than those in the extracted zip file.
'       If True, an existing folder will first be deleted, then recreated.
'
'   Path and Destination can be relative paths. If so, the current path is used.
'
'   If success, 0 is returned, and Destination holds the full path of the created folder.
'   If error, error code is returned, and Destination will be zero length string.
'
' Early binding requires references to:
'
'   Shell:
'       Microsoft Shell Controls And Automation
'
'   Scripting.FileSystemObject:
'       Microsoft Scripting Runtime
'
' 2023-10-28. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function UnZip( _
    ByVal Path As String, _
    Optional ByRef Destination As String, _
    Optional ByVal OverWrite As Boolean) _
    As Long
    
#If EarlyBinding Then
    ' Microsoft Scripting Runtime.
    Dim FileSystemObject    As Scripting.FileSystemObject
    ' Microsoft Shell Controls And Automation.
    Dim ShellApplication    As Shell
    
    Set FileSystemObject = New Scripting.FileSystemObject
    Set ShellApplication = New Shell
#Else
    Dim FileSystemObject    As Object
    Dim ShellApplication    As Object

    Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set ShellApplication = CreateObject("Shell.Application")
#End If
               
    ' Extension of a cabinet file holding one or more files.
    Const CabExtensionName  As String = "cab"
    ' Extension of an archive file holding one or more files.
    Const TarExtensionName  As String = "tar"
    ' Extension of a compressed archive file holding one or more files.
    Const TgzExtensionName  As String = "tgz"
    ' Mandatory extension of zip file.
    Const ZipExtensionName  As String = "zip"
    Const ZipExtension      As String = "." & ZipExtensionName
    
    ' Constants for Shell.Application.
    Const DoOverwrite       As Long = &H0&
    Const NoOverwrite       As Long = &H8&
    Const YesToAll          As Long = &H10&
    ' Custom error values.
    Const ErrorNone         As Long = 0
    Const ErrorOther        As Long = -1
    
    Dim ZipName             As String
    Dim ZipPath             As String
    Dim ZipTemp             As String
    Dim Options             As Variant
    Dim Result              As Long
    
    If FileSystemObject.FileExists(Path) Then
        ' The source is an existing file.
        ZipName = FileSystemObject.GetBaseName(Path)
        ZipPath = FileSystemObject.GetFile(Path).ParentFolder
    End If
    
    If ZipName = "" Then
        ' Nothing to unzip. Exit.
        Destination = ""
    Else
        ' Select or create destination folder.
        If Destination <> "" Then
            ' Unzip to a custom folder.
            If _
                FileSystemObject.GetExtensionName(Destination) = CabExtensionName Or _
                FileSystemObject.GetExtensionName(Destination) = TarExtensionName Or _
                FileSystemObject.GetExtensionName(Destination) = TgzExtensionName Or _
                FileSystemObject.GetExtensionName(Destination) = ZipExtensionName Then
                ' Do not unzip to a folder named *.cab, *.tar, or *.zip.
                ' Strip extension.
                Destination = FileSystemObject.BuildPath( _
                    FileSystemObject.GetParentFolderName(Destination), _
                    FileSystemObject.GetBaseName(Destination))
            End If
        Else
            ' Unzip to a subfolder of the folder of the zipfile.
            Destination = FileSystemObject.BuildPath(ZipPath, ZipName)
        End If
            
        If FileSystemObject.FolderExists(Destination) And OverWrite = True Then
            ' Delete the existing folder.
            FileSystemObject.DeleteFolder Destination, True
        End If
        If Not FileSystemObject.FolderExists(Destination) Then
            ' Create the destination folder.
            FileSystemObject.CreateFolder Destination
        End If
        
        If Not FileSystemObject.FolderExists(Destination) Then
            ' For some reason the destination folder does not exist and cannot be created.
            ' Exit.
            Destination = ""
        Else
            ' Destination folder existed or has been created successfully.
            ' Resolve relative paths.
            Destination = FileSystemObject.GetAbsolutePathName(Destination)
            Path = FileSystemObject.GetAbsolutePathName(Path)
            ' Check file extension.
            If FileSystemObject.GetExtensionName(Path) = ZipExtensionName Then
                ' File extension is OK.
                ZipTemp = Path
            Else
                ' Rename the zip file by adding a zip extension.
                ZipTemp = Path & ZipExtension
                FileSystemObject.MoveFile Path, ZipTemp
            End If
            ' Unzip files and folders from the zip file to the destination folder.
            If OverWrite Then
                Options = DoOverwrite Or YesToAll
            Else
                Options = NoOverwrite Or YesToAll
            End If
            ShellApplication.Namespace(CVar(Destination)).CopyHere ShellApplication.Namespace(CVar(ZipTemp)).Items, Options
            If ZipTemp <> Path Then
                ' Remove the zip extension to restore the original file name.
                FileSystemObject.MoveFile ZipTemp, Path
            End If
        End If
    End If
    
    Set ShellApplication = Nothing
    Set FileSystemObject = Nothing
    
    If Err.Number <> ErrorNone Then
        Destination = ""
        Result = Err.Number
    ElseIf Destination = "" Then
        Result = ErrorOther
    End If
    
    UnZip = Result
     
End Function

Полный код на GitHub: VBA.Compress.

Полная документация на бирже экспертов:

Архивируйте и распаковывайте файлы и папки с помощью VBA с помощью Проводника Windows

Это было действительно полезно, спасибо!

cody 22.06.2024 18:33

Иногда проще заменить токен, когда используется много кавычек.

Используя ваш подход 7zip:

Sub TESTER()
    
    Dim runThis As String, srcZip As String, destFile As String
    'The whole text passed to cmd also needs quoting
    Const CMD = "cmd /c  "" ""<7zip>"" e ""<zip>"" -so > ""<dest>"" "" "
    
    srcZip = "C:\Temp\TestFile.zip"
    destFile = Replace(srcZip, ".zip", ".xlsx")
    
    runThis = ReplaceTokens(CMD, "<7zip>", "C:\Program Files\7-Zip\7z.exe", _
                                "<zip>", srcZip, _
                                "<dest>", destFile)
    Debug.Print runThis
    Shell runThis, vbNormalFocus
    
End Sub

'repalce tokens in `txt` using info supplied in `args`
Function ReplaceTokens(ByVal txt As String, ParamArray args())
    Dim i As Long, rv As String
    For i = LBound(args) To UBound(args) Step 2
        txt = Replace(txt, args(i), args(i + 1))
    Next i
    ReplaceTokens = txt
End Function

Это тоже очень полезно, спасибо!! :)

cody 22.06.2024 18:32

Другие вопросы по теме