XL 2013 le dézipage ne fonctionne pas

[patricktoulon]

Bonjour a tous
j'ai un petit soucis avec dezip and rezip
j'aimerais sortir le dossier "_rels" et mettre le mien
ou l’écraser avec le mien
pour le sortir movehere ne fonctionne pas
pour l’écrasement j'ai un msgbox me disant de renommer le fichier donc l’écrasement niet

voir les lignes "sortie du dossier" et "insertion du dossier"

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

 

[patricktoulon]

je fourni les aspro si tu veux