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
Code: Select all
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