Compresser un excel en VBA pour l'envoyer par mail

Bonjour,
Voila je vous explique mon probleme je developpe en ce moment sur Access et je doit en vba compresser en zip des fichiers excel pour les envoyé par mails aprés . Dans mon code actuel je fonctionne avec des table dynamiques , je transfert ces tables grace a ce petit boue de code qui marche:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, ligne.Fields("Requete"), chemin & ligne.Fields("Requete")

ligne.Fields("Requete")= Correspond a la localisation de ma table
chemin & ligne.Fields("Requete")= Correspond a la requete de mon fichier

Je souhaite en utilisant ceci pouvoir correspondre avec le code qui va suivre l'envoi de mon fichier excel compresser . J'ai trouver sur le net comment compresser mais mon probleme c'est qu'il localise d'abord le fichier et apres il le zip. Voici le code qui fonctionne en zippant :

Sub zipfichier(chemin, maDate, nomFichier)

    Dim oShell As Object, Fso As Object
    Dim i As Long
    Dim Fichier As String, MyBinary As String
    Dim LeZip As Variant
    Dim MyHex As Variant
       
    Fichier = "C:\Users\GHHN5133\Documents\ZIP\DEMANDE_DEV.csv"
    LeZip = "C:\Users\GHHN5133\Documents\ZIP\DEV.zip"
     
    Set Fso = CreateObject("Scripting.FileSystemObject")
    MyHex = _
        Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
    
    For i = 0 To UBound(MyHex)
        MyBinary = MyBinary & Chr(MyHex(i))
    Next
    
    With Fso.CreateTextFile(LeZip, True)
        .Write MyBinary
        .Close
    End With
    
    Set oShell = CreateObject("Shell.Application")
    oShell.Namespace(LeZip).CopyHere (Fichier)
    
    Set oShell = Nothing
End Sub

Pouvez vous m'aider ?