[Resolvido]Comprimir Pasta e Subpastas

Boa noite amigos

Com o comando abaixo comprimo com Winrar a BD. Mas junto da BD tem outras subpastas.
Como as incluir neste comando
Obrigado

Sub ComprimePastaComWinRar()
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim WinRarPath As String 'Localização do WinRar.exe
Dim RarIt As String 'Instrução de linha de comando
Dim SourceDir As String 'O diretório de origem
Dim DestDir As String 'O diretório de destino
Dim DestRarName As String
Dim Dest As String 'Caminho de destino concatenado

FromPath = Me!CaminhoEscolhido

ToPath = Me!CaminhoEscolhido

'inicia a criação da pasta
Set fs = CreateObject("Scripting.FileSystemObject")
'se a pasta existir, deleta

If Right(FromPath, 1) = "\" Then
FromPath = Left(FromPath, Len(FromPath) - 1)
End If
If Right(ToPath, 1) = "\" Then
ToPath = Left(ToPath, Len(ToPath) - 1)
End If
Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " não existe."
Exit Sub
End If
'copia
FSO.CopyFolder Source:=FromPath, Destination:=ToPath

'*** Verifica se existe instalação do WinRar ***
WinRarPath = "C:\Program Files (x86)\WinRar\"

If Dir(WinRarPath, vbDirectory) = "" Then
MsgBox "O WinRar não está instaldo nesse diretorio." _
& Chr$(13) & "Impossivel comprimir."
Exit Sub
End If

SourceDir = Me.CaminhoEscolhido

'Verifica se a Pasta tem espaços nos nomes
If InStr(1, SourceDir, " ", vbTextCompare) <> 0 Then SourceDir = Chr(34) & SourceDir & Chr(34)

'Letra do Drive de destino
DestDir = Me.CaminhoEscolhido

If Dir(DestDir, vbDirectory) = "" Then MkDir DestDir
DestRarName = "Backup.Rar"
Dest = DestDir & "\" & DestRarName
If InStr(1, Dest, " ", vbTextCompare) <> 0 Then Dest = Chr(34) & Dest & Chr(34)

RarIt = shell(WinRarPath & "WinRar.exe a " & Dest & " " & SourceDir, vbNormalFocus)
MsgBox "Backup criado com sucesso...", vbInformation, "Aviso"

DoCmd.Quit
End Sub

Bom dia, Assis
Transforma esse procedimento em função. Depois, é listar pasta com sub-pastas e, em cada instância, executar a função

Bom Dia,
Não sei se o parametro -r do WinRAR pode ajudar.
Ficando assim no código:

RarIt = shell(WinRarPath & "WinRar.exe a -r " & Dest & " " & SourceDir, vbNormalFocus)


Verifique estes links:
http://acritum.com/software/manuals/winrar/html/helpswr.htm
http://www.ihler.org/Docs/compacta.html

Abraço

Bom dia Alvaro

Valioso este -r
Obrigado