Envoyer fichier vers corbeille

[jprog46]

Bonjour,
J'utilise le code présenté dans la FAQ d Access, code qui fonctionne parfaitement pour supprimer
un fichier ou un répertoire.

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
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

Il suffit de rechercher le handle de la fenêtre en utilisant

Code :

1
2
Private Declare Function FindWindowA Lib "user32" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

associé à :

Code :

1
2
Dim MeHwnd As Long
    MeHwnd = FindWindowA(vbNullString, Me.Caption)

à placer dans le code.

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 de

Code :

 DansCorbeille = (Result = 0) And (DelFileOp.fAnyOperationsAborted = 0)

Voici mon code :

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
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