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