如何使用VBA解压7z格式压缩文件？

你的代码能正常保存附件但无法完成7z解压，核心是几个语法和工具选择错误，下面一一修正并给出完整解决方案：

关键错误点 #

1. 误用7-Zip图形界面程序：7zFM.exe是带可视化界面的版本，命令行解压必须用7z.exe，否则无法通过Shell执行无交互的解压操作。
2. 程序路径字符串未闭合：pathTo7Zip = "C:\Program Files\7-Zip\7zFM.exe 末尾缺少闭合双引号，直接导致语法错误。
3. 命令拼接引号混乱：savedFilePath的引用部分多了多余双引号，导致命令无法识别目标文件路径。
4. 文件名处理有风险：若附件名无后缀，Split会触发下标越界；路径拼接可能出现冗余双斜杠（比如C:\Users\Desktop\\mon_PROD.csv）。

修正后的完整代码 #

Dim ValidExtensions As Collection
Set ValidExtensions = New Collection

ValidExtensions.Add "csv"
ValidExtensions.Add "txt"
ValidExtensions.Add "xls"
ValidExtensions.Add "7z"
ValidExtensions.Add "zip"

Debug.Print "Checking attachments"

For Each objAttachment In objItem.Attachments
    Debug.Print "Found attachment: " & objAttachment.fileName

    Dim extension As String
    ' 处理无后缀的文件名，避免下标越界
    extension = ""
    If InStr(objAttachment.fileName, ".") > 0 Then
        extension = LCase(Split(objAttachment.fileName, ".")(UBound(Split(objAttachment.fileName, "."))))
    End If
    Debug.Print "Extension: " & extension

    Dim isValidExtension As Boolean
    isValidExtension = False

    Dim validExtension As Variant
    For Each validExtension In ValidExtensions
        If extension = validExtension Then
            isValidExtension = True
            Debug.Print "Valid extension found"
            Exit For
        End If
    Next validExtension

    If isValidExtension Then
        Dim savedFilePath As String
        ' 修复路径双斜杠问题
        savedFilePath = monthFolder & IIf(Right(monthFolder, 1) = "\", "", "\") & objAttachment.fileName
        Debug.Print "Saving file to: " & savedFilePath
        objAttachment.SaveAsFile savedFilePath
        
        ' 用7z统一处理7z和zip文件
        If extension = "7z" Or extension = "zip" Then
            Debug.Print extension & " file found, starting extraction"
            Dim pathTo7Zip As String
            ' 指向命令行版本的7z.exe，根据实际安装路径调整
            pathTo7Zip = "C:\Program Files\7-Zip\7z.exe"
            Dim command As String
            ' 正确拼接命令：7z.exe e "源文件路径" -o"输出目录" -y（-y自动确认所有交互提示）
            command = """" & pathTo7Zip & """ e """ & savedFilePath & """ -o""" & monthFolder & """ -y"
            Debug.Print "Running command: " & command
 
            ' 执行命令并等待解压完成（无需等待可直接用Shell command）
            Dim shellPID As Double
            shellPID = Shell(command, vbMinimizedFocus) ' 后台执行
            
            ' 等待进程结束的逻辑（可选）
            Dim wmiService As Object, process As Object
            Set wmiService = GetObject("winmgmts:\\.\root\cimv2")
            Do
                On Error Resume Next
                Set process = wmiService.Get("Win32_Process.Handle='" & shellPID & "'")
                On Error GoTo 0
                DoEvents
            Loop While Not process Is Nothing
        End If
    End If
Next objAttachment

额外检查事项 #

• 确认7-Zip安装路径正确，若为32位版本，路径应为"C:\Program Files (x86)\7-Zip\7z.exe"。
• 确保monthFolder对应的目录存在，可在代码开头添加：If Dir(monthFolder, vbDirectory) = "" Then MkDir monthFolder。
• 你的立即窗口日志中无7z文件处理记录，测试时需确保附件包含7z格式文件，否则不会触发解压逻辑。

内容的提问来源于stack exchange，提问作者bhukz