Replace vbaProject.bin in XLSM excel file-CodePudding

I have an excel file named "Sample.xlsm" and in the same path of the excel file, I have a vbaProject.bin file How can I replace the embedded vbaproject.bin in the xlsm file with my own .bin file? I have searched and found a code but it doesn't work for me

Sub ReplaceVBABin7z()

    Const SevenZipExe = "C:\Program Files\7-Zip\7z.exe"
    Const tmpDir = "c:\temp\7z\"
    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

CodePudding user response：

Here's a method which uses the built-in Shell methods for working with zip archives:

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