Zipar pastas e arquivos com o WinRAR

Exemplo de chamada para arquivo:
call fncZipaWinRAR("d:\Arquivo.txt","d:\Arquivo.rar")
call fncZipaWinRAR("d:\*.txt","d:\Arquivo.rar","123")

Exemplo de chamada para pasta:
call fncZipaWinRAR("d:\PastaQualquer\*","d:\PastaQualquer.rar")
call fncZipaWinRAR("d:\PastaQualquer\","d:\PastaQualquer.rar")
call fncZipaWinRAR("d:\PastaQualquer,"d:\PastaQualquer.rar")

Código:

Public Sub fncZipaWinRAR(ByVal strOrigem As String, _
                        ByVal strDestino As String, _
                        Optional ByVal strSenha As String = "", _
                        Optional ByVal booEvitaAlteracao As Boolean = True, _
                        Optional ByVal booMantemOriginal As Boolean = False)
' ----------------------------------------------------------------
' Autor    : DamascenoJr. (contato@damascenojr.com.br)
' Data      : 02/11/2020
' Propósito : Zipar pasta(s) e arquivo(s) com o WinRAR
' ----------------------------------------------------------------

    Dim strDirWinRAR As String
   
    strDirWinRAR = fncDirWinRAR
   
    If strDirWinRAR = "" Then
        Call MsgBox("WinRAR não detectado.", vbCritical, "WinRAR")
        Exit Sub
    End If

    strDirWinRAR = strDirWinRAR & IIf(booEvitaAlteracao, " -k", "")
    strDirWinRAR = strDirWinRAR & IIf(booMantemOriginal, " a", " m")
    strDirWinRAR = strDirWinRAR & IIf(strSenha <> "", " -hp" & strSenha, "")
    strDirWinRAR = strDirWinRAR & IIf((Dir(strOrigem, vbArchive) = "") Or (Right(strOrigem, 1) Like "[\*]"), " -r", "")
    strDirWinRAR = strDirWinRAR & " -ep1 -ibck"
   
    Call Shell(strDirWinRAR & " """ & strDestino & """ """ & strOrigem & """", vbHide)

End Sub

Private Function fncDirWinRAR() As String
' ----------------------------------------------------------------
' Propósito : Retornar o caminho do arquivo WinRAR.exe
' ----------------------------------------------------------------

On Error GoTo trataErro

    Dim objWS          As Object
    Dim strResultado    As String

    Set objWS = CreateObject("WScript.Shell")
   
    strResultado = objWS.RegRead("HKEY_LOCAL_MACHINE\" & _
                                "SOFTWARE\" & _
                                "Microsoft\" & _
                                "Windows\" & _
                                "CurrentVersion\" & _
                                "App Paths\" & _
                                "WinRAR.exe\Path") & "\WinRAR.exe"
                               
    If Dir(strResultado, vbArchive) = "" Then strResultado = ""
   
sair:
On Error Resume Next
    Set objWS = Nothing
    fncDirWinRAR = strResultado
    Exit Function
   
trataErro:
    strResultado = ""
    Resume sair

End Function

Olá Damasceno,

Parabéns e obrigado pela partilha.