XL 2010 Supprimer les doublons

[sams96]

Bonjour à tous ,
J'ai réussi à créer une macro qui me permet de parcourir tout les sous dossiers de mon dossier principal , et exporter tous les fichiers ppt de ses sous dossier et dont le nom commence par " EN" en fichier pdf dans un autre dossier (foldest)
Quand je fais tourner ma macro pour la première fois cette dernière fonctionne parfaitement , et tout mes fichiers ppt sont convertit en pdf .
Malheureusement quand je fais tourner ma macro une deuxième fois , cette dernière prend les meme fichiers ppt de mes sous dossiers , et les exporte en pdf ,
ce qui me crée donc des doublon au niveau de mon fichier foldest .
Est ce qu il serait possible de m aider à modifier ma macro , de telle manière à ne pas avoir des fichiers en double dans mon dossier foldest , et cela a chaque fois ou je fais tourner ma macro .
Je m'excuse de mon niveau de francais , mais je suis un étudiant étranger .
Je vous remercie par avance.

Sub EN()
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
Dim Fso As Object, objFolder As Object, objSubFolder As Object
Dim FromPath As String
Dim FileInFolder As Object
Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Set ppApp = CreateObject("PowerPoint.Application")
FromPath = "C:\Users\samiess\Desktop\parent"
foldest = "C:\Users\samiess\Desktop\resultat\"

Set Fso = CreateObject("Scripting.filesystemobject")
Set objFolder = Fso.GetFolder(FromPath)

For Each objSubFolder In objFolder.subfolders
    For Each FileInFolder In objSubFolder.Files
    
    On Error GoTo Catch
    
     If FileInFolder.Name Like "*EN*" Then
            Set ppPres = ppApp.Presentations.Open(FileInFolder, msoFalse, msoFalse, msoFalse)
          
          
           ppApp.Visible = True: ppApp.Activate
      
            ppPres.ExportAsFixedFormat foldest & Dir(FileInFolder) & ".pdf", ppFixedFormatTypePDF, ppFixedFormatIntentPrint
    
Catch:
    If err.Number = -2147467259 Then
        TrapSaveAsErrorNumber = False
    ElseIf (StrComp(err.Description, "Presentation (unknown member) : Invalid request.  Presentation cannot be modified.")) Then
        TrapSaveAsErrorNumber = False
    Else
        TrapSaveAsErrorNumber = False
    End If
           End If
  
    Next FileInFolder
Next objSubFolder


strFolder = "C:\Users\samiess\Desktop\EN\"
          strFile = Dir(strFolder & "\*.*")
         Do While Len(strFile) > 0
         If InStr(strFile, "pptx") > 0 Then
         Name strFolder & strFile As strFolder & Replace(strFile, "pptx", "pdf")
       End If
         strFile = Dir()
       Loop
      
End Sub

 

[Hasco]

Bonjour,

Insérez cette ligne après If FileInFolder.Name Like "*EN*" Then:

If Fso.FileExists(  foldest & FileInFolder.Name & ".pdf") Then Fso.DeleteFile foldest & FileInFolder.Name & ".pdf"

pour tester si le fichier existe déjà et le supprimer éventuellement.

Bon tests

 

[sams96]

Bonjour @Roblochon
je viens d'essayer à nouveau ma macro , en rajoutant cette nouvelle ligne de code , mais elle fonctionne pas , j ai toujours des fichiers en double qui se créent .
Merci d'avance .

 

[Hasco]

Bonjour,

Difficile de répondre sans plus de précision que 'elle fonctionne pas'.
L'idée principale étant avant la ligne de création d'un nouveau fichier de vérifier si celui-ci existe sur le disque et si oui, le supprimer.
Aller voir l'aide de FileSystemObject : Aide FSO

P.S. votre français est très bon.

Bon après-midi