Macro pour supprimer des fichiers

Version imprimable

Bonjour,

Mon problème est le suivant :

Je récupère dans mon fichier excel une liste de nom de fichier pdf.
Ensuite, je veux supprimer parmi ces fichiers une certaine partie à partir de ma macro VBA.

J'arrive à supprimer le fichier à partir du nom qui se situe en A1 avec ce programme :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Sub Test2() Range("A1").Select Dim sNomFichier As String sNomFichier = "C:\Users\Thomas\Desktop\renommage de fichiers pdf\LOAD\" & Range("A1") Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFile(sNomFichier) f.Delete End Sub
Je voudrais automatiser ce programme sur toute les cellules de la colonne A tant quelles sont non vides.

Merci.

Salut, à adapter à ton contexte

Code:

1
2
3
4
5
6
7
8
9
Option Explicit
 
Dim LastRow As Long
Dim i As Long
 
    LastRow = Feuil1.Range("A" & Rows.Count).End(xlDown).Row
    For i = 1 To LastRow
        Kill Feuil1.Range("A" & i)
    Next i

Solution moins définitive, les fichiers sont déplacés vers la corbeille, à adapter.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Option Explicit
 
Private Type SHFILEOPSTRUCT
    hwnd As Long
    wFunc As Long
    sFrom As String
    sTo As String
    fFlags As Integer
    fAnyOperationsAborted As Boolean
    hNameMappings As Long
    lpszProgressTitle As String
End Type
 
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
                                         (ByRef lpFileOp As SHFILEOPSTRUCT) As Long
 
Private Const FO_DELETE = &H3
Private Const FOF_SILENT = &H4
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_ALLOWUNDO = &H40
 
Sub DelFichier()
Dim oFilAPI As SHFILEOPSTRUCT
Dim iRet As Long
Dim sFichier As String
Dim LastRow As Long
Dim i As Long
 
    LastRow = Feuil1.Range("A" & Rows.Count).End(xlDown).Row
    For i = 1 To LastRow
        sFichier = Feuil1.Range("A" & i)
 
        With oFilAPI
            .wFunc = FO_DELETE
            .sFrom = sFichier
            .sTo = vbNullChar
            .fFlags = FOF_SILENT + FOF_NOCONFIRMATION + FOF_ALLOWUNDO
        End With
 
        iRet = SHFileOperation(oFilAPI)
    Next i
End Sub

Salut ,

Merci de votre aide.

J'ai essayé les 2 codes, je n'arrive à en faire fonctionner aucun.

J'ai essayé avec ce code ci:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Test5()
 
Dim LastRow As Long
Dim i As Long
LastRow = Range("A" & Rows.Count).End(xlDown).Row
For i = 1 To LastRow
    Dim sNomFichier As String
    sNomFichier = "C:\Users\tliberti\Desktop\renommage de fichiers pdf\LOAD\" & Range("A" & i)
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(sNomFichier)
    f.Delete
 
   Next i
 
 End Sub

ça me dit fichier introuvable.

Ok ça marche mais...

Voici le code qui fonctionne :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Test5()
 
Dim LastRow As Long
Dim i As Long
LastRow = Range("A" & Rows.Count).End(xlDown).Row
For i = 1 To LastRow
    Dim sNomFichier As String
    sNomFichier = "C:\Users\tliberti\Desktop\renommage de fichiers pdf\LOAD\" & Range("A" & i)
    Kill sNomFichier
 
 
   Next i
 
 End Sub

Mais, après, ça me dit fichier introuvable. comment ne pas obtenir ce bug ?

19/07/2012, 10h26
Philippe Tulliez
Bonjour,

Citation:

Mais, après, ça me dit fichier introuvable. comment ne pas obtenir ce bug ?

Ce n'est pas un bug, c'est un message d'erreur qui te signale qu'il est impossible de supprimer un fichier qui n'existe pas.
Pour éviter ce message d'erreur
Code:

1 2 3 On Error Resume Next Kill "z:\tests\toto.xls" On Error GoTo 0

YOUHOU !!

OK, J 'AI REUSSI YOUHOU !!!

MERCI À TOUS !

Voici le code:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Test5()
 
Dim LastRow As Long
Dim i As Long
LastRow = Range("A" & Rows.Count).End(xlDown).Row
 
For i = 1 To LastRow
 
    Dim sNomFichier As String
    sNomFichier = "C:\Users\tliberti\Desktop\renommage de fichiers pdf\LOAD\" & Range("A" & i)
    On Error Resume Next
    Kill sNomFichier
    If Err = 53 Then Exit Sub
   Next i
 
 End Sub

:ccool: