Macro Suppression Dossier Compréssé

[MuscatMimi]

Bonjour a tout le Forum

je cherche a créer une macro,pour supprimer un
Dossier Compréssé

Le Code Ci-dessous, me permet de supprimer un Dossier
mais pas un Dossier Compréssé

je ne vois pas comment faire

Sub Test()
Dim rer As String
rer = "Temp" 

Set fs = CreateObject("Scripting.FileSystemObject")

'--Supprime Fichier
'Set f = fs.GetFolder(ThisWorkbook.path & "\" & rer) 

' Supprime Dossier
Set f = fs.GetFolder(TTT) Set f = fs.GetFolder(ThisWorkbook.path & "\" & rer)  On Error Resume Next
f.Delete
End Sub

Cordialement

 

[kiki29]

Re : Macro Suppression Dossier Compréssé

Salut, sans savoir si cela peut t'aider voir Recycle A File Or Folder ainsi que Copy, Move and Delete files and folders

 

[Staple1600]

Re : Macro Suppression Dossier Compréssé

Bonjour à tous


Sauf erreur de ma part, un dossier compressé

C'est un fichier *.zip

Donc à considérer comme un fichier et non pas comme un dossier.

EDITION: Salutations dominicales au sieur Kjin 😉

 

[kjin]

Re : Macro Suppression Dossier Compréssé

Bonjour,
Même observation que Staple à moins que qq chose nous échappe...

dossier = ThisWorkbook.Path & "\Temp.zip"
If Dir(dossier) <> "" Then Kill dossier

A+
kjin

 

[YANN-56]

Re : Macro Suppression Dossier Compréssé

Bonjour Vaucluse, et à tous,

Pour ma part, je pense qu'il est à proscrire d'écrire "Kill" où que ce soit!!!
(Sauf le respect que je dois à ceux qui en parlent)

Une erreur de chemin peut avoir un effet catastrophique,
et non récupérable dans un répertoire. (Je sais de quoi je parle!!!) 😡

La procédure pour passer par la corbeille n'est pas des plus simples,
mais vivement souhaitable... (En plus c'est une sorte de sauvegarde)

Une recherche par ici devrait te permettre de trouver.

Sinon, il me faudra un morceau de temps pour retrouver, mais
je devrais avoir dans mes archives quelque chose dans ce sens.

Si besoin.... A plus.

Amicalement.

Yann

 

[kiki29]

Re : Macro Suppression Dossier Compréssé

Re, comme dit plus haut voir Recycle A File Or Folder

 

[YANN-56]

Re : Macro Suppression Dossier Compréssé

Bonsoir kiki, mon voisin de l'ouest,
Mais pas plus loin, sinon "Plouf", et à cette époque l'eau est trop froide!!! 🙂

J'ai regardé ce que j'avais en archives, mais je n'ai pas encore trouvé.

Pour la petite histoire, sur mon ancien PC, j'avais un rack en IDE.
et 5 DD me servaient de sauvegarde et d'archives.

Depuis un coup de foudre du tonnerre de Brest, j'en ai un nouveau,
mais en sata ou un truc comme ça (J'pige rien dans leur bidule) 🙁
En plus, ils ne me m'ont pas laissé de place pour le tiroir "Rack"

Donc je suis obligé de tout éteindre pour changer de disque!
brancher ces cosses qui ont du mal à entrer, et redémarrer... Pfft!

Si tu as de ton coté un exemple de mise à la corbeille d'un Fichier ou Dossier,
je pense que cela entrerait bien dans l'aide à apporter à notre ami,
comme à beaucoup, je le pense. (Tous le monde ne cause pas le Grand Breton)

Amicalement, et à te lire

Yann

P.S. Si tu apportes une réponse, je gagnerai du temps.
Sinon; je poursuivrai mes recherches.

 

[kjin]

Re : Macro Suppression Dossier Compréssé

Re,

Pour ma part, je pense qu'il est à proscrire d'écrire "Kill" où que ce soit!!!
(Sauf le respect que je dois à ceux qui en parlent)
Une erreur de chemin peut avoir un effet catastrophique,
et non récupérable dans un répertoire. (Je sais de quoi je parle!!!)

😕😕😕
Il faudra également prévenir tous ceux qui utilisent la méthode Delete du FSO 🙄
Personnellement j'utilise Schredder pour être sûr que le fichier a été durablement supprimé et éviter les poubelles qui débordent !
kjin 😡

 

[MuscatMimi]

Re : Macro Suppression Dossier Compréssé

Bonsoir a tous les intervenents


Merci a vous tous

Je savais pas qu'un dossier .Zip, était considéré comme Fichier

J'ai opté pour le Code de Kjin
qui fonctionne bien

Maintenant, je vais a nouveau vous soumettre un de mes autres soucis
Dans le Code ci_dessous, qui me Sauvegarde le Classeur entier
j'aimerais inclure que la Sauvegarde d'un Classeur avec juste la feuille Facture
J'ai dans le Module1 la Sub "Enregistrer" qui elle m'enregistre bien un classeur
avec la feuille Facture
J'arrive pas a inclure cette procédure dans le Code "Sauvegarde" du Module 2

je n'y arrive pas

'Option Explicit

Sub Sauvegarde()

Dim ABC As String, Temp As String, Ret As String, Jour As String, dossier1 As String, sousdossier2 As String, Nom As String, Dossier3 As String, Nom1 As String

Dim Dat As String, Nom3 As String, Utilisateur As String

Dim Cible As Object, Dossier As Object
Dim réponse1
    réponse1 = MsgBox("Vous Allez Sauvegarder Votre Fichier ( ATTENTION sauvegarde automatique ! )  ", vbYesNo + vbQuestion, "Validation")
    If réponse1 = vbNo Then Exit Sub
Nom = "Sauvegarde"
dossier1 = ThisWorkbook.Path & "\" & Nom
Nom1 = "Temp"
Dossier3 = ThisWorkbook.Path & "\" & Nom1
If Dir(Dossier3, vbDirectory) = "" Then MkDir (Dossier3)
Dat = Format(Sheets("settings").Range("B15"), "DD mmmm yyyy")
Nom3 = Sheets("settings").Range("B16")
Utilisateur = Sheets("settings").Range("B17")

If Dir(dossier1, vbDirectory) = "" Then MkDir (dossier1)
sousdossier2 = ThisWorkbook.Path
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs dossier1 & "\" & Nom3 & "  " & Dat & "  " & "  " & Utilisateur & ".xls"
ActiveWorkbook.SaveAs sousdossier2 & "\Envoi Mail Outlook Express" & ".xls"
ActiveWorkbook.SaveAs Dossier3 & "\" & Nom3 & "  " & Dat & "  " & "  " & Utilisateur & ".xls"

ActiveWorkbook.SaveAs sousdossier2 & "\Envoi Mail Outlook Express" & ".xls"
'Zip_ActiveWorkbook
MsgBox "Sauvegarde Effectuée . ", vbInformation, "Message"
Unload Me
Application.DisplayAlerts = True

End Sub

@+++++++merci encore

 

[kjin]

Re : Macro Suppression Dossier Compréssé

Bonsoir Christian 🙂,
Peux tu reformuler ta question, je n'ai pas compris ce qu'il fallait faire
Juste, au cas où, tu peux peut-être appeler une procédure depuis l'autre (et Lycée de versailles...)
A+
kjin

 

[YANN-56]

Re : Macro Suppression Dossier Compréssé

Ok kjin,

J'ai loupé une occasion de me taire!

Je pensais bien faire... Désolé!
(La sauvegarde préalable me rassure cependant 🙂)

Amicalement, et au plaisir.

Yann

 

[MuscatMimi]

Re : Macro Suppression Dossier Compréssé

Bjr a tous

Bon en persévérant , j'y suis arrivé

[COLOR=GREEN]'Option Explicit[/COLOR]

[COLOR=GREEN]'--Procédure V3[/COLOR]
[COLOR=BLUE]Public[/COLOR] rap [COLOR=BLUE]As String[/COLOR], Fiche [COLOR=BLUE]As String[/COLOR]


[COLOR=BLUE]Sub[/COLOR] Enregistrement03()
[COLOR=BLUE]Dim[/COLOR] C [COLOR=BLUE]As Byte[/COLOR], Q [COLOR=BLUE]As String[/COLOR]
[COLOR=BLUE]Dim[/COLOR] nom1 [COLOR=BLUE]As String[/COLOR]
Application.ScreenUpdating = [COLOR=BLUE]False[/COLOR]
Application.DisplayAlerts = [COLOR=BLUE]False[/COLOR]
[COLOR=GREEN]'--Nomme les cellules[/COLOR]
[COLOR=GREEN]'If Range("B26").Value = "" Then Exit Sub[/COLOR]
[COLOR=GREEN]'''''''''If Range("B3").Value = "" Then Exit Sub 'dossier temp[/COLOR]
nom1 = "Temp"
[COLOR=GREEN]'If Range("B2").Value = "" Then Exit Sub[/COLOR]
[COLOR=BLUE]If[/COLOR] Range("B25").Value = "" [COLOR=BLUE]Then Exit Sub[/COLOR] [COLOR=GREEN]'Nom Fichier[/COLOR]

[COLOR=GREEN]'If Range("B4").Value = "" And Range("B5").Value = "" And Range("B6").Value = "" Then Exit Sub[/COLOR]
[COLOR=BLUE]If[/COLOR] Range("B27").Value = "" [COLOR=BLUE]And[/COLOR] Range("B28").Value = "" [COLOR=BLUE]And[/COLOR] Range("B29").Value = "" [COLOR=BLUE]Then Exit Sub[/COLOR]

[COLOR=GREEN]'[/COLOR]

[COLOR=GREEN]'--Crée Dossier au Nom du Client Cell B1[/COLOR]
[COLOR=GREEN]'rep = "F:\Mes Documents Cat\FactureClient\" & Range("B1").Value 'B1 Donne le Nom au Dossier[/COLOR]
[COLOR=GREEN]'rap = ThisWorkbook.path & "\" & Range("B3").Value 'B1 Donne le Nom au Dossier[/COLOR]
rap = ThisWorkbook.path & "\" & nom1 [COLOR=GREEN]'B1 Donne le Nom au Dossier[/COLOR]

[COLOR=BLUE]If Not[/COLOR] RépertoireExiste(rap) [COLOR=BLUE]Then[/COLOR]
[COLOR=BLUE]If Not[/COLOR] MakeDirEx(rap$) [COLOR=BLUE]Then Exit Sub[/COLOR]
[COLOR=BLUE]End If[/COLOR]

[COLOR=BLUE]With[/COLOR] ActiveWorkbook
[COLOR=GREEN]'--Enregistre la Feuille sous le Nom des cellules Nommées B1,B2 etc[/COLOR]
    Fiche = Range("B25") & "_" & "_" & Range("B27") & "_" & "_" & Range("B28") & "_" & "_" & Range("B29")
        [COLOR=BLUE]For[/COLOR] C = 1 [COLOR=BLUE]To[/COLOR] Len(Fiche) [COLOR=GREEN]'test caractères interdits[/COLOR]
            [COLOR=BLUE]If[/COLOR] InStr("\/:*?""""<>|", Mid(Fiche, C, 1)) > 0 [COLOR=BLUE]Then[/COLOR]
                MsgBox "Attention, il y a des des caractères interdits !"
                [COLOR=BLUE]Exit Sub[/COLOR]
            [COLOR=BLUE]End If[/COLOR]
        
        [COLOR=BLUE]Next[/COLOR]
        [COLOR=BLUE]Dim[/COLOR] g [COLOR=BLUE]As String[/COLOR]
    [COLOR=BLUE]If[/COLOR] Dir(rap & "\" & Fiche & ".xls") <> "" [COLOR=BLUE]Then[/COLOR] [COLOR=GREEN]'test existence fichier[/COLOR]
        Q = MsgBox(Fiche & " Existe déjà, voulez-vous le remplacer ?", vbYesNo)
        [COLOR=BLUE]If[/COLOR] Q = vbNo [COLOR=BLUE]Then[/COLOR]
            [COLOR=BLUE]Exit Sub[/COLOR]
         [COLOR=BLUE]Else[/COLOR]
            CopierUneFeuilleSansCodeVBA "Feuil1"
            
        [COLOR=BLUE]End If[/COLOR]
    [COLOR=BLUE]Else[/COLOR]
        CopierUneFeuilleSansCodeVBA "Feuil1"
    [COLOR=BLUE]End If[/COLOR]
[COLOR=BLUE]End With[/COLOR]

[COLOR=GREEN]'ThisWorkbook.Close SaveChanges:=True[/COLOR]

Application.ScreenUpdating = [COLOR=BLUE]True[/COLOR]
Application.DisplayAlerts = [COLOR=BLUE]True[/COLOR]
ActiveWindow.Close  [COLOR=GREEN]' ferme le classeur créé[/COLOR]

[COLOR=BLUE]End Sub[/COLOR]

[COLOR=BLUE]Sub[/COLOR] CopierUneFeuilleSansCodeVBA(NomFeuille$) [COLOR=GREEN]' Frédéric Sigonneau[/COLOR]
ActiveWorkbook.Sheets(NomFeuille).Copy
[COLOR=BLUE]With[/COLOR] ActiveWorkbook
    [COLOR=BLUE]With[/COLOR] .VBProject.VBComponents(Sheets(NomFeuille).CodeName).CodeModule
        .DeleteLines 1, .CountOfLines
    [COLOR=BLUE]End With[/COLOR]
    .SaveAs rap & "\" & Fiche & ".xls"
[COLOR=BLUE]End With[/COLOR]
[COLOR=BLUE]End Sub[/COLOR]

[COLOR=GREEN]'Option Explicit[/COLOR]

[COLOR=BLUE]Public[/COLOR] rap [COLOR=BLUE]As String[/COLOR], Fiche [COLOR=BLUE]As String[/COLOR]


[COLOR=BLUE]Sub[/COLOR] Enregistrement04()
[COLOR=BLUE]Dim[/COLOR] C [COLOR=BLUE]As Byte[/COLOR], Q [COLOR=BLUE]As String[/COLOR]
[COLOR=BLUE]Dim[/COLOR] nom1 [COLOR=BLUE]As String[/COLOR]
Application.ScreenUpdating = [COLOR=BLUE]False[/COLOR]
Application.DisplayAlerts = [COLOR=BLUE]False[/COLOR]
[COLOR=GREEN]'--Nomme les cellules[/COLOR]
[COLOR=GREEN]'If Range("B26").Value = "" Then Exit Sub[/COLOR]
[COLOR=GREEN]'''''''''If Range("B3").Value = "" Then Exit Sub 'dossier temp[/COLOR]
Nom2 = "Sauvegarde"
[COLOR=GREEN]'If Range("B2").Value = "" Then Exit Sub[/COLOR]
[COLOR=BLUE]If[/COLOR] Range("B25").Value = "" [COLOR=BLUE]Then Exit Sub[/COLOR] [COLOR=GREEN]'Nom Fichier[/COLOR]

[COLOR=GREEN]'If Range("B4").Value = "" And Range("B5").Value = "" And Range("B6").Value = "" Then Exit Sub[/COLOR]
[COLOR=BLUE]If[/COLOR] Range("B27").Value = "" [COLOR=BLUE]And[/COLOR] Range("B28").Value = "" [COLOR=BLUE]And[/COLOR] Range("B29").Value = "" [COLOR=BLUE]Then Exit Sub[/COLOR]

[COLOR=GREEN]'[/COLOR]

[COLOR=GREEN]'--Crée Dossier au Nom du Client Cell B1[/COLOR]
[COLOR=GREEN]'rep = "F:\Mes Documents Cat\FactureClient\" & Range("B1").Value 'B1 Donne le Nom au Dossier[/COLOR]
[COLOR=GREEN]'rap = ThisWorkbook.path & "\" & Range("B3").Value 'B1 Donne le Nom au Dossier[/COLOR]
rap = ThisWorkbook.path & "\" & Nom2 [COLOR=GREEN]'B1 Donne le Nom au Dossier[/COLOR]

[COLOR=BLUE]If Not[/COLOR] RépertoireExiste(rap) [COLOR=BLUE]Then[/COLOR]
[COLOR=BLUE]If Not[/COLOR] MakeDirEx(rap$) [COLOR=BLUE]Then Exit Sub[/COLOR]
[COLOR=BLUE]End If[/COLOR]

[COLOR=BLUE]With[/COLOR] ActiveWorkbook
[COLOR=GREEN]'--Enregistre la Feuille sous le Nom des cellules Nommées B1,B2 etc[/COLOR]
    Fiche = Range("B25") & "_" & "_" & Range("B27") & "_" & "_" & Range("B28") & "_" & "_" & Range("B29")
        [COLOR=BLUE]For[/COLOR] C = 1 [COLOR=BLUE]To[/COLOR] Len(Fiche) [COLOR=GREEN]'test caractères interdits[/COLOR]
            [COLOR=BLUE]If[/COLOR] InStr("\/:*?""""<>|", Mid(Fiche, C, 1)) > 0 [COLOR=BLUE]Then[/COLOR]
                MsgBox "Attention, il y a des des caractères interdits !"
                [COLOR=BLUE]Exit Sub[/COLOR]
            [COLOR=BLUE]End If[/COLOR]
        
        [COLOR=BLUE]Next[/COLOR]
        [COLOR=BLUE]Dim[/COLOR] g [COLOR=BLUE]As String[/COLOR]
    [COLOR=BLUE]If[/COLOR] Dir(rap & "\" & Fiche & ".xls") <> "" [COLOR=BLUE]Then[/COLOR] [COLOR=GREEN]'test existence fichier[/COLOR]
        Q = MsgBox(Fiche & " Existe déjà, voulez-vous le remplacer ?", vbYesNo)
        [COLOR=BLUE]If[/COLOR] Q = vbNo [COLOR=BLUE]Then[/COLOR]
            [COLOR=BLUE]Exit Sub[/COLOR]
         [COLOR=BLUE]Else[/COLOR]
            CopierUneFeuilleSansCodeVBA "Feuil1"
            
        [COLOR=BLUE]End If[/COLOR]
    [COLOR=BLUE]Else[/COLOR]
        CopierUneFeuilleSansCodeVBA "Feuil1"
    [COLOR=BLUE]End If[/COLOR]
[COLOR=BLUE]End With[/COLOR]

[COLOR=GREEN]'ThisWorkbook.Close SaveChanges:=True[/COLOR]

Application.ScreenUpdating = [COLOR=BLUE]True[/COLOR]
Application.DisplayAlerts = [COLOR=BLUE]True[/COLOR]
ActiveWindow.Close  [COLOR=GREEN]' ferme le classeur créé[/COLOR]

[COLOR=BLUE]End Sub[/COLOR]

[COLOR=BLUE]Sub[/COLOR] CopierUneFeuilleSansCodeVBA(NomFeuille$) [COLOR=GREEN]' Frédéric Sigonneau[/COLOR]
ActiveWorkbook.Sheets(NomFeuille).Copy
[COLOR=BLUE]With[/COLOR] ActiveWorkbook
    [COLOR=BLUE]With[/COLOR] .VBProject.VBComponents(Sheets(NomFeuille).CodeName).CodeModule
        .DeleteLines 1, .CountOfLines
    [COLOR=BLUE]End With[/COLOR]
    .SaveAs rap & "\" & Fiche & ".xls"
[COLOR=BLUE]End With[/COLOR]
[COLOR=BLUE]End Sub[/COLOR]

[COLOR=BLUE]Function[/COLOR] RépertoireExiste(Chemin [COLOR=BLUE]As String[/COLOR]) [COLOR=BLUE]As Boolean[/COLOR] [COLOR=GREEN]'L. Longre[/COLOR]
  [COLOR=BLUE]On Error Resume Next[/COLOR]

  RépertoireExiste = GetAttr(Chemin) [COLOR=BLUE]And[/COLOR] vbDirectory
[COLOR=BLUE]End Function[/COLOR]

[COLOR=BLUE]Function[/COLOR] MakeDirEx(DirPath$) [COLOR=BLUE]As Boolean[/COLOR] [COLOR=GREEN]'Frédéric Sigonneau[/COLOR]
[COLOR=BLUE]Dim[/COLOR] i%, tmp, Arr
[COLOR=BLUE]If[/COLOR] InStr(1, DirPath, ":") = 0 [COLOR=BLUE]Then[/COLOR]
    Arr = Split(CurDir & "\" & DirPath, "\")
[COLOR=BLUE]Else[/COLOR]: Arr = Split(DirPath, "\")
[COLOR=BLUE]End If[/COLOR]
  
tmp = Arr(0)
[COLOR=BLUE]For[/COLOR] i = [COLOR=BLUE]LBound[/COLOR](Arr) + 1 [COLOR=BLUE]To UBound[/COLOR](Arr)
    [COLOR=BLUE]If[/COLOR] Arr(i) <> "" [COLOR=BLUE]Then[/COLOR]
        tmp = tmp & "\" & Arr(i)
        [COLOR=BLUE]On Error Resume Next[/COLOR]
        MkDir tmp
        [COLOR=BLUE]On Error GoTo 0[/COLOR]
    [COLOR=BLUE]End If[/COLOR]
[COLOR=BLUE]Next[/COLOR]
  
[COLOR=BLUE]If[/COLOR] Dir(DirPath, vbDirectory) = "" [COLOR=BLUE]Then[/COLOR]
    [COLOR=BLUE]On Error Resume Next[/COLOR]
    RmDir Arr(0) & "\" & Arr(1)
    [COLOR=BLUE]On Error GoTo 0[/COLOR]
[COLOR=BLUE]Else[/COLOR]
    MakeDirEx = [COLOR=BLUE]True[/COLOR]
[COLOR=BLUE]End If[/COLOR]
    
[COLOR=BLUE]End Function[/COLOR]

[COLOR=BLUE]Sub[/COLOR] Test()
[COLOR=BLUE]Dim[/COLOR] rer [COLOR=BLUE]As String[/COLOR]
rer = "Temp" [COLOR=GREEN]'TextBox5.Value[/COLOR]
[COLOR=BLUE]Set[/COLOR] fs = CreateObject("Scripting.FileSystemObject")

[COLOR=GREEN]'--Supprime Fichier[/COLOR]
[COLOR=GREEN]'Set f = fs.GetFolder(ThisWorkbook.path & "\" & rer) '& "\" & "Modele1.xls")  '("C:\Documents and Settings\Christian\Bureau\MergeWorkbooksCode\Nou") '= on veut supprimer le fichier c:\fichier.xls[/COLOR]
[COLOR=GREEN]'--Supprime Dossier[/COLOR]
[COLOR=BLUE]Set[/COLOR] f = fs.GetFolder(ThisWorkbook.path & "\" & rer)  [COLOR=GREEN]'("C:\Documents and Settings\Christian\Bureau\MergeWorkbooksCode\Nou") '= on veut supprimer le fichier c:\fichier.xls[/COLOR]
[COLOR=BLUE]On Error Resume Next[/COLOR]
f.Delete

[COLOR=GREEN]'--Supprime Dossier Nom.Zip[/COLOR]
Dossier = ThisWorkbook.path & "\Nom.zip"
[COLOR=BLUE]If[/COLOR] Dir(Dossier) <> "" [COLOR=BLUE]Then[/COLOR] Kill Dossier
[COLOR=BLUE]End Sub[/COLOR]

Merci encore de votre intervention

Par contre pour ce qui est de Kill, ou .delete
je n'ai pas compris

Cordialement

 

[MuscatMimi]

Re : Macro Suppression Dossier Compréssé

Bonsoir

Maintenant ,que tout fonctionne bien
je viens d'avoir une autre idées

je désire pouvoir choisir la ou les feuilles du classeur a sauvegarder
si quelqu'un a une idée, elle sera la bienvenue

Bonne soirée
Cordialement