XL 2013 le dézipage ne fonctionne pas

Public newprojetFolder$
Public SampleC$
Public SampleZip$
Public previewZip$
Public dézipé$
Sub newprojet()
    With Application: .ScreenUpdating = False: .DisplayAlerts = False: End With
    newprojetFolder = ThisWorkbook.Path & "\NewProjet"
    dézipé = newprojetFolder & "\dezip"
    If Dir(newprojetFolder, vbDirectory) <> "" Then deleteFolder newprojetFolder
    MkDir newprojetFolder
    MkDir newprojetFolder & "\dezip"
    MkDir newprojetFolder & "\dezip\_rels"
    MkDir newprojetFolder & "\dezip\customUI"

    SampleC = newprojetFolder & "\sample.xlsm"
    SampleZip = newprojetFolder & "\sample.zip"
    previewZip = newprojetFolder & "\preview.zip"
    With Workbooks.Add: .SaveAs Filename:=SampleC, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False: .Close: End With
    Application.ScreenUpdating = True
    Do While Dir(SampleC) = "": DoEvents: Loop
    Name SampleC As SampleZip
    FileCopy SampleZip, previewZip
    CreatedemoXML
    DeplacerFichierDanspreviewsZip
End Sub

Sub deleteFolder(dossier)
    With CreateObject("Scripting.FileSystemObject"): .GetFolder(dossier).Delete: End With
End Sub
Sub CreatedemoXML()
    fichier = newprojetFolder & "\dezip\customUI\customUI14.xml"
    x = FreeFile: Open fichier For Append As #x: Print #x, [A2].Text: Close #x
    fichier = newprojetFolder & "\dezip\customUI\customUI.xml"
    x = FreeFile: Open fichier For Append As #x: Print #x, [A3].Text: Close #x
    fichier = newprojetFolder & "\dezip\_rels\.rels"
    x = FreeFile: Open fichier For Append As #x: Print #x, [A1].Text: Close #x
End Sub


Sub DeplacerFichierDanspreviewsZip()

'gestion des erreurs
    On Error GoTo ErreurCompression

'définition des variables
    Dim ApplicationArchivage As Object
    Dim dossier, dossier2, FichierZip
  
'informations sur les fichiers (chemins & noms)
     FichierZip = newprojetFolder & "\preview.zip"
     dossier = newprojetFolder & "\dezip\customUI"
    dossier2 = newprojetFolder & "\dezip\_rels"
  
'je voudrais sortir le dossier "_rels"
'ApplicationArchivage.Namespace(newprojetFolder).moveHere ApplicationArchivage.Namespace(FichierZip).items.Item("_rels") ' sortie du dossier

'copier le dossier dans l'archive
    Set ApplicationArchivage = CreateObject("Shell.Application")
    ApplicationArchivage.Namespace(FichierZip).copyHere dossier
    Application.Wait Now + 0.00001

'si je n'arrive pas a le sortir au moins l'ecraser avec celui là!!!!!!!!!!!
ApplicationArchivage.Namespace(FichierZip).copyHere dossier2' insertion du dossier
   'Message final
    MsgBox "L'archivage a été mis à jour..."

Exit Sub
ErreurCompression:
    MsgBox "Une erreur s'est produite..."
End Sub