替换 XLSM excel 文件中的 vbaProject.bin

Question

我有一个名为“Sample.xlsm”的 excel 文件，在 excel 文件的相同路径中，我有一个 vbaProject.bin 文件如何用我自己的 .bin 文件替换 xlsm 文件中嵌入的 vbaproject.bin？我已经搜索并找到了一个代码，但它对我不起作用

Sub ReplaceVBABin7z()

    Const SevenZipExe = "C:\Program Files-Zipz.exe"
    Const tmpDir = "c:\tempz\"
    Dim qq As String: qq = Chr(34)  '"
    
    ' check 7-zip exe exists
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.fileexists(SevenZipExe) Then
        MsgBox SevenZipExe & " not found", vbCritical, "7-Zip Not found"
        Exit Sub
    End If
    
    ' create list of commands available
    Dim cmd As String, pid As Double
    'cmd = "cmd /c """ & SevenZipExe & """ >" & tmpDir & "7-Zip_Commands.txt"
    'pid = Shell(cmd, vbHide)
    'MsgBox "Command List see " & tmpDir & "7-Zip_Commands.txt", vbInformation, pid
    
    Dim path As String
    Dim strFileName As String, strBinName As String

    ' select workbook
    path = ThisWorkbook.path & "\"
    strFileName = Application.GetOpenFilename("Excel Macro Enabled Workbook (*.xlsm), *.xlsm")
    If strFileName = "False" Then Exit Sub
    strFileName = qq & strFileName & qq ' quoted for spaces in filename
       
ext:
    ' extract xl dir and sub dirs into tmpdir
    cmd = qq & SevenZipExe & qq & " x -r -y -o" & qq & tmpDir & qq & " " & _
           strFileName & " xl"
    pid = Shell(cmd, vbHide)
    Debug.Print pid, cmd
    MsgBox "xl directory from " & strFileName & " extracted to " & tmpDir, vbInformation, "EXTRACT pid=" & pid
    'Shell "Taskkill -pid " & pid

del:
    ' delete xl\vbaProject.bin dir and subdir
    strBinName = "xl\vbaProject.bin"
    cmd = qq & SevenZipExe & qq & " d -r " & _
          strFileName & " " & strBinName
    pid = Shell(cmd, vbHide)
    Debug.Print pid, cmd
    MsgBox strBinName & " deleted from " & strFileName, vbInformation, "DELETE pid=" & pid
    'Shell "Taskkill -pid " & pid

upd:
    ' update xl dir and subdir
    cmd = qq & SevenZipExe & qq & " u -r -y -stl " & _
          strFileName & " " & qq & tmpDir & "xl" & qq
    pid = Shell(cmd, vbHide)
    Debug.Print pid, cmd
    MsgBox strFileName & " updated from " & tmpDir, vbInformation, "UPDATE pid=" & pid
    'Shell "Taskkill -pid " & pid

End Sub

Answer 1

这是一个使用 built-in Shell 方法处理 zip 存档的方法：

Sub ReplaceInZip()

    Const BASE As String = "C:\Temp\VBA\"
    Dim fldr, zpath, itm, vrbs, vrb

    zpath = BASE & "blah.xlsm"      'the file to be modified
    Name zpath As zpath & ".zip"    'add a .zip extension 
    
    With CreateObject("Shell.Application")
        Set fldr = CreateObject("Shell.Application").Namespace(zpath & ".zip" & "\xl")
        'remove the existing bin file by moving it out to an "old" folder
        For Each itm In fldr.items
            If itm.Name = "vbaProject.bin" Then
                .Namespace(BASE & "old").moveHere itm
                'add timestamp to moved file
                Name BASE & "old\vbaProject.bin" As _
                     BASE & "old\vbaProject.bin." & Format(Now, "yyyy-mm-dd-hhnnss")
                Exit For
            End If
        Next itm
        fldr.Copyhere "C:\Temp\VBA\vbaProject.bin"
        Application.Wait Now + TimeSerial(0, 0, 2) 'wait for copy to complete
    End With
    
    Name zpath & ".zip" As zpath
    
End Sub

替换 XLSM excel 文件中的 vbaProject.bin

Replace vbaProject.bin in XLSM excel file

excel

vba