VBA supprimer fichiers PDF en fonction d'une liste

Le 30/10/2023 à 16:57

Bonsoir à tous,

Je souhaiterais pouvoir supprimer des fichiers PDF en fonction d'une liste Excel,

Je vous un fichier exemple pour une meilleure compréhension de ma demande,

Merci d'avance pour votre aide,

Cordialement,

7test-pdf.xlsx (11.28 Ko)
Le 31/10/2023 à 01:04

bonsoir,

une proposition. Attention la macro supprime définitivement les fichiers. Prendre une bonne sauvegarde avant l'exécution !

Sub aargh()
    With Sheets("feuil1")
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        rep = "P:\ATEST\SITE\PIECE SITE\" ' <-------------- A vérifier minutieusement
        nf = Dir(rep & "\*.pdf") ' à vérifier
        Do Until nf = ""
            Set re = .Range("C1").Resize(dl, 1).Find(Left(nf, Len(nf) - 4), lookat:=xlWhole)
            If re Is Nothing Then
                ans = MsgBox("supprimer fichier " & rep & nf, vbYesNo)
                If ans = vbYes Then Kill rep & nf
            Else
                MsgBox "on garde " & nf & " car dans la liste"
            End If
            nf = Dir()
        Loop
    End With
End Sub

version sans demande de confirmation de la suppression

Sub aargh()
    With Sheets("feuil1") ' à adapter éventuellement
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        rep = "P:\ATEST\SITE\PIECE SITE\"
        nf = Dir(rep & "*.pdf")
        Do Until nf = ""
            Set re = .Range("C1").Resize(dl, 1).Find(Left(nf, Len(nf) - 4), lookat:=xlWhole)
            If re Is Nothing Then Kill rep & nf
            nf = Dir()
        Loop
    End With
End Sub
Le 31/10/2023 à 15:23

Bonjour h2so4,

Merci beaucoup pour votre retour,

cependant comment peut on rendre variable le répertoire rep car celui ci va varier en fonction des données des colonnes B & C,

Merci d'avance,

Cordialement,

Le 31/10/2023 à 15:58

bonjour,

le répertoire rep car celui ci va varier en fonction des données des colonnes B & C,

cela m'avait échappé donc on a un fichier dont le chemin complet ressemble à ceciP:\ATEST\C\00000250\00000250.pdf

dans ce cas :

Sub aargh()
    Set dict = CreateObject("scripting.dictionary")
    With Sheets("feuil1")
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 2 To dl
            dict(.Cells(i, 2).Value & "\" & .cells(i,3).value) = 1 'on met dans le dictionnaire les sous répertoires sites à examiner
        Next i
        For Each site In dict.keys
            rep = "P:\ATEST\" & site ' <-------------- A vérifier minutieusement
            nf = Dir(rep & "\*.pdf") ' à vérifier on sélectionne tous les fichiers dont l'extension est .pdf
            Do Until nf = ""
                Set re = .Range("C1").Resize(dl, 1).Find(Left(nf, Len(nf) - 4), lookat:=xlWhole)
                If re Is Nothing Then
                    ans = MsgBox("supprimer fichier " & rep & "\" & nf, vbYesNo)
                    If ans = vbYes Then Kill rep & "\" & nf
                Else
                    MsgBox "on garde " & rep & "\" & nf & " car dans la liste"
                End If
                nf = Dir()
            Loop
        Next site
    End With
End Sub

version sans demande de confirmation de la suppression

Sub aargh()
    Set dict = CreateObject("scripting.dictionary")
    With Sheets("feuil1")
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 2 To dl
            dict(.Cells(i, 2).Value) = 1 'on met dans le dictionnaire les sous répertoires sites à examiner
        Next i
        For Each site In dict.keys
            rep = "P:\ATEST\" & site ' <-------------- A vérifier minutieusement
            nf = Dir(rep & "\*.pdf") ' à vérifier on sélectionne tous les fichiers dont l'extension est .pdf
            Do Until nf = ""
                Set re = .Range("C1").Resize(dl, 1).Find(Left(nf, Len(nf) - 4), lookat:=xlWhole)
                If re Is Nothing Then Kill rep & "\" & nf
                nf = Dir()
            Loop
        Next site
    End With
End Sub
Le 31/10/2023 à 16:46

Bonjour h2so4,

Non le répertoire ressemblerait à P:\ATEST\C\00000250.pdf

Désolé ne pas avoir été plus explicite sur ce point, je suppose qu'il faudrait modifier le code mais je ne sais ou?,

Merci d'avance,

Cordialement

Le 31/10/2023 à 19:15

bonsoir,

Non le répertoire ressemblerait à P:\ATEST\C\00000250.pdf

dire que c'est ce que j'avais initialement fait, avant de me rendre compte que cela ne correspondait pas à ce que j'ai compris de tes explications.

Sub aargh()
    Set dict = CreateObject("scripting.dictionary")
    With Sheets("feuil1")
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 2 To dl
            dict(.Cells(i, 2).Value) = 1  'on met dans le dictionnaire les sous répertoires sites à examiner
        Next i
        For Each site In dict.keys
            rep = "P:\ATEST\" & site ' <-------------- A vérifier minutieusement
            nf = Dir(rep & "\*.pdf") ' à vérifier on sélectionne tous les fichiers dont l'extension est .pdf
            Do Until nf = ""
                Set re = .Range("C1").Resize(dl, 1).Find(Left(nf, Len(nf) - 4), lookat:=xlWhole)
                If re Is Nothing Then
                    ans = MsgBox("supprimer fichier " & rep & "\" & nf, vbYesNo)
                    If ans = vbYes Then Kill rep & "\" & nf
                Else
                    MsgBox "on garde " & rep & "\" & nf & " car dans la liste"
                End If
                nf = Dir()
            Loop
        Next site
    End With
End Sub

sans confirmation de suppression

Sub aargh()
    Set dict = CreateObject("scripting.dictionary")
    With Sheets("feuil1")
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 2 To dl
            dict(.Cells(i, 2).Value) = 1  'on met dans le dictionnaire les sous répertoires sites à examiner
        Next i
        For Each site In dict.keys
            rep = "P:\ATEST\" & site ' <-------------- A vérifier minutieusement
            nf = Dir(rep & "\*.pdf") ' à vérifier on sélectionne tous les fichiers dont l'extension est .pdf
            Do Until nf = ""
                Set re = .Range("C1").Resize(dl, 1).Find(Left(nf, Len(nf) - 4), lookat:=xlWhole)
                If re Is Nothing Then Kill rep & "\" & nf
                nf = Dir()
            Loop
        Next site
    End With
End Sub
Le 01/11/2023 à 08:41

Bonjour h2so4,

C'est parfait, après test vos solutions correspondent parfaitement et l'exécution est très rapide !

Merci d'avoir résolu ma demande,

Bonne journée de Toussaint à vous,

Cordialement,

Rechercher des sujets similaires à "vba supprimer fichiers pdf fonction liste"