我已经寻找解决方案，但找不到任何解决方案。我只想解压缩一个文件并将输出重命名为 zip 文件名（例如 myfile.zip ---> myfile.xls）。我的 zip 文件每个仅包含一个 xls 文件。这段代码几乎达到了我想要的效果，但我只在 tempFolder 中得到一个空的 myfile.xls （0 kByte）：
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。
完整文档位于专家交流：