Zipando via VBA com o 7Zip

Segue uma adaptação de um código que eu peguei na internet.
Não é de minha autoria, mas vou deixar aqui para futuras consultas.
É bom ressaltar que o 7Zip é um compactador free e até o último comparativo que fiz, tinha uma taxa de compressão melhor que a do WinRAR.

Option Explicit
 
Dim nome_zip        As Variant
Dim pasta_a_zipar   As Variant
Dim strDate         As String
Dim Pasta_destino   As String
Dim oApp            As Object
 
 
Sub Zipar_tudo_com_7Zip()
   
    'Pasta onde estará o arquivo zipado
    Pasta_destino = "C:\Users\todorok\Desktop\"
 
    'Pasta que contém os arquivos a serem zipados
    pasta_a_zipar = "C:\Users\todorok\Desktop\Kaizen\"
 
    'Arquivo zip que contém os arquivos compactados
    nome_zip = Pasta_destino & "backup" & ".zip"
 
    'Criar um arquivo zip vazio
    Call Novo_zip_vazio(nome_zip)
 
    Set oApp = CreateObject("Shell.Application")
    'Copiar os arquivos para dentro do arquivo zip vazio
    oApp.NameSpace(nome_zip).CopyHere oApp.NameSpace(pasta_a_zipar).Items
 
    'Aguardar o término da compactação
    On Error Resume Next
    Do Until oApp.NameSpace(nome_zip).Items.Count = oApp.NameSpace(pasta_a_zipar).Items.Count
        Application.Wait (Now + TimeValue("0:00:01"))
    Loop
    On Error GoTo 0
 
    MsgBox "Fim!"
End Sub
 
Sub Novo_zip_vazio(sPath)
    'Se já existir um arquivo zip, apagá-lo e criar um novo
    If Len(Dir(sPath)) > 0 Then Kill sPath
    Open sPath For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1
End Sub