Bonjour,
J'utilise le code présenté dans la FAQ d Access, code qui fonctionne parfaitement pour supprimer
un fichier ou un répertoire.
Il suffit de rechercher le handle de la fenêtre en utilisant
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61 Private Sub cmdTest_Click() ' On va transférer le film de son répertoire actuel vers son répertoire définitif Dim fDialog As Office.FileDialog Dim fso As FileSystemObject Set fso = New FileSystemObject Dim varFile As Variant, f Dim fileName As String, FileNamerepert As String Dim oliste As DAO.Recordset ' Choix du film source Set fDialog = Application.FileDialog(msoFileDialogFilePicker) With fDialog .AllowMultiSelect = False ' plusieurs fichiers à la fois .Title = "Choisir le fichier source." .InitialFileName = "E:\usenet\download\Filemaster" If .Show = True Then FileSourceTot = "" For Each varFile In .SelectedItems FileSourceTot = varFile strpos = InStrRev(varFile, "\") ' nom du répertoire source FileNamerepert = Mid$(varFile, 1, strpos - 1) strTemp = Mid$(varFile, InStrRev(varFile, "\") + 1) strpos = InStrRev(strTemp, ".") FileSourceNameNoExt = Left$(strTemp, InStrRev(strTemp, ".") - 1) FileSourceNameExt = Mid$(strTemp, strpos) Next Else MsgBox "Vous avez Cancelé le choix." Exit Sub End If End With msgResult = MsgBox("Le fichier doit être SEUL dans son répertoire !!!", vbOKCancel) If msgResult = vbCancel Then Exit Sub '*** constitution du répertoire final, basé sur genre et titreFR ' filtrer Lise de films sur base de son N° sourcefolder = FileSourceTot DoCmd.Hourglass True targetfolder = "e:\test01" & FileSourceNameExt fso.CopyFile sourcefolder, targetfolder, True DoCmd.Hourglass False ' supprimer répertoire source Set fso = Nothing Set fDialog = Nothing ' Dim MeHwnd As Long MeHwnd = FindWindowA(vbNullString, Me.Caption) ' FileNamerepert = nom du répertoire source If DansCorbeille(FileNamerepert, MeHwnd) Then MsgBox "Le fichier a été déplacé dans la corbeille" Else MsgBox "Le fichier n'a pas pu être déplacé dans la corbeille" End If End Sub
associé à :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2 Private Declare Function FindWindowA Lib "user32" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
à placer dans le code.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2 Dim MeHwnd As Long MeHwnd = FindWindowA(vbNullString, Me.Caption)
Toutefois, si avant de lancer la routine d'envoi dans la corbeille, je fais une copie du fichier,
lorsque j’accepte l’envoi, j’ai le message d’erreur de Microsoft Windows comme quoi le fichier est déjà utilisé par une autre personne ou un autre programme.
Le module (ci-après) est assez simple.
Schématiquement :
- Choix d’un fichier (source) via : Application.FileDialog(msoFileDialogFilePicker)
- Constitution d’un nouveau nom (target)
- Copie de source vers target : fso.CopyFile sourcefolder, targetfolder, True
- Suppression du répertoire qui contenait le fichier, donc suppression également du fichier
Le message s’affiche à l’exécution deVoici mon code :
Code : Sélectionner tout - Visualiser dans une fenêtre à part DansCorbeille = (Result = 0) And (DelFileOp.fAnyOperationsAborted = 0)
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61 Private Sub cmdTest_Click() ' On va transférer le film de son répertoire actuel vers son répertoire définitif Dim fDialog As Office.FileDialog Dim fso As FileSystemObject Set fso = New FileSystemObject Dim varFile As Variant, f Dim fileName As String, FileNamerepert As String Dim oliste As DAO.Recordset ' Choix du film source Set fDialog = Application.FileDialog(msoFileDialogFilePicker) With fDialog .AllowMultiSelect = False ' plusieurs fichiers à la fois .Title = "Choisir le fichier source." .InitialFileName = "E:\usenet\download\Filemaster" If .Show = True Then FileSourceTot = "" For Each varFile In .SelectedItems FileSourceTot = varFile strpos = InStrRev(varFile, "\") ' nom du répertoire source FileNamerepert = Mid$(varFile, 1, strpos - 1) strTemp = Mid$(varFile, InStrRev(varFile, "\") + 1) strpos = InStrRev(strTemp, ".") FileSourceNameNoExt = Left$(strTemp, InStrRev(strTemp, ".") - 1) FileSourceNameExt = Mid$(strTemp, strpos) Next Else MsgBox "Vous avez Cancelé le choix." Exit Sub End If End With msgResult = MsgBox("Le fichier doit être SEUL dans son répertoire !!!", vbOKCancel) If msgResult = vbCancel Then Exit Sub '*** constitution du répertoire final, basé sur genre et titreFR ' filtrer Lise de films sur base de son N° sourcefolder = FileSourceTot DoCmd.Hourglass True targetfolder = "e:\test01" & FileSourceNameExt fso.CopyFile sourcefolder, targetfolder, True DoCmd.Hourglass False ' supprimer répertoire source Set fso = Nothing Set fDialog = Nothing ' Dim MeHwnd As Long MeHwnd = FindWindowA(vbNullString, Me.Caption) ' FileNamerepert = nom du répertoire source If DansCorbeille(FileNamerepert, MeHwnd) Then MsgBox "Le fichier a été déplacé dans la corbeille" Else MsgBox "Le fichier n'a pas pu être déplacé dans la corbeille" End If End Sub
C’est sans doute l’opération de copie qui maintient un lien avec le fichier mais je ne vois pas comment.
Pourriez-vous m’aider ?
Merci d'avance pour votre aide.
Cordialement,
JP
Partager