Jak przenieść plik (lub folder) do kosza?

Istnieje w VBA instrukcja KILL, która trwale kasuje plik. Czasami jednak potrzebujemy przenieść plik do kosza (np. nasza aplikacja kasuje poprzednio wykonaną kopię pliku ale na wszelki wypadek nie chcemy go na razie trwale kasować).

Nie ma w VBA instrukcji, która przenosi plik do kosza, tutaj trzeba będzie się posiłkować Win32API.

Oto przykładowy kod przenoszący plik (lub folder wraz z podfolderami) do kosza.

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
    
    Private Const FO_DELETE As Long = &H3
    Private Const FOF_ALLOWUNDO As Long = &H40
    Private Const FOF_NOCONFIRMATION As Long = &H10
    
    Private Type SHFILEOPSTRUCT
        hwnd As LongPtr
        wFunc As Long
        pFrom As String
        pTo As String
        fFlags As Integer
        fAnyOperationsAborted As Boolean
        hNameMappings As LongPtr
        lpszProgressTitle As String
    End Type
#Else
    Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
    
    Private Const FO_DELETE As Long = &H3
    Private Const FOF_ALLOWUNDO As Long = &H40
    Private Const FOF_NOCONFIRMATION As Long = &H10
    
    Private Type SHFILEOPSTRUCT
        hwnd As Long
        wFunc As Long
        pFrom As String
        pTo As String
        fFlags As Integer
        fAnyOperationsAborted As Boolean
        hNameMappings As Long
        lpszProgressTitle As String
    End Type
#End If

Function PrzeniesDoKosza(ByVal filePath As String) As Long
    Dim fileOp As SHFILEOPSTRUCT
    
    With fileOp
        .wFunc = FO_DELETE
        .pFrom = filePath & Chr(0) & Chr(0)
        .fFlags = FOF_ALLOWUNDO Or FOF_NOCONFIRMATION
    End With
    
    PrzeniesDoKosza = SHFileOperation(fileOp)
End Function


Sub TestKosza()
    Dim result As Long
    
    ' Skasuj plik
    result = PrzeniesDoKosza("c:\TEMP\aaa.txt")
    
    ' Skasuj cały folder (wraz z ewentualnymi plikami i podfolderami w tym folderze)
    ' result = PrzeniesDoKosza("c:\TEMP\Kopie")
    
    If result <> 0 Then
        MsgBox "Nie udało się przenieść pliku do kosza", vbExclamation
    Else
        MsgBox "Plik został przeniesiony do kosza", vbInformation
    End If
End Sub

Wskazówka: funkcja PrzeniesDoKosza kasuje „po cichu” plik bez pytania się użytkownika o zgodę. Jeśli chcesz, aby pojawiło się pytanie o zgodę, to w funkcji PrzeniesDoKosza w linijce .fFlags = FOF_ALLOWUNDO Or FOF_NOCONFIRMATION należy usunąć Or FOF_NOCONFIRMATION

Uwaga: jeśli plik (folder) nie istnieje to nasza funkcja zwróci błąd. Dlatego dobrze jest sprawdzić, czy plik (folder), który chcemy skasować istnieje. To zagadnienie opisałem w notce: Jak sprawdzić, czy plik lub folder istnieje?

Uwaga: jeśli chcesz przenieść folder do kosza to podajemy ścieżkę do folderu bez ukośnika na końcu. Przykładowo wywołanie funkcji result = PrzeniesDoKosza(„c:\TEMP\Kopie”) jest poprawne, ale wywołanie funkcji result = PrzeniesDoKosza(„c:\TEMP\Kopie\”) (z ukośnikiem na końcu) zwróci błąd.

Uwaga: jeśli plik znajduje się na pendrive, to zostanie on skasowany (a nie przeniesiony do kosza)