 Recycling A File Or Folder
Recycling A File Or Folder
This page describes VBA code to send a file or folder to the Windows Recycle Bin and to
empty the Recycle Bin.
 
VB/VBA provides no method for sending a file to the Windows Recycle Bin. VB does provide the Kill
statement, but this permanently and irretrievably deletes a file. However, using some Windows API functions, you can send
a file or folder to the Recycle Bin. When specifying a file or folder to recycle, you must provide the fully
qualified file name, including drive and folder information. For example,
C:\Some\Folder\File.xls
is valid, but 
Some\Folder\File.xls
is not valid because it lacks a drive and possibly a folder specification. You may not recycle files on a remote machine. 
This page describes two procedures for recycling a file: Recycle and RecycleSafe.
The Recycle function allows you to recycle any file or folder as long as the operating system will allow it.
The RecycleSafe function prohibits you from recycling certain files and folders. These prohibited files and
folders are:
- ThisWorkbook
- ThisWorkbook.Path
- Application.Path
- Any root directory
- System Directory (typically C:\Windows\System32)
- Windows Directory (typically C:\Windows)
- Program Files (typically C:\Program Files)
- My Documents (typically C:\Documents And Settings\username\My Documents
- Desktop (typically C:\Documents And Settings\username\Desktop)
- Any file specification with wildcard characters (* or ?)
- Any file or folder with the System attribute set
- A file that is currently open
The folder restrictions of 
RecycleSafe prevent you from deleting those folders in their entirety, 
but you can delete any file or folder within those folders, as long that operation is allowed by the operating system.
This page also includes a procedure for emptying the Recycle Bin.
The procedure declarations for Recycle and RecycleSafe are show below:
Public Function Recycle(FileSpec As String, Optional ErrText As String) As Boolean
Public Function RecycleSafe(FileSpec As String, Optional ByRef ErrText As String) As Boolean
In both procedures, 
FileSpec is the fully qualified name of the file or folder to be recycled. These
must be fully qualified with drive and folder specifications.  The functions return 
True if the 
recycle operation was successful or 
False is an error occurred. If an error occurs, the 
ErrText variable will contain a text description of the error. 
You can download a bas module file containing the code on this page.

The following code is used by both Recycle and RecycleSafe and should be 
placed in the declarations section of a module (outside of and before any procedures).
Private Declare Function SHFileOperation Lib "shell32.dll" Alias _
    "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Declare Function PathIsNetworkPath Lib "shlwapi.dll" _
    Alias "PathIsNetworkPathA" ( _
    ByVal pszPath As String) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" _
    Alias "GetSystemDirectoryA" ( _
    ByVal lpBuffer As String, _
    ByVal nSize As Long) As Long
Private Declare Function SHEmptyRecycleBin _
    Lib "shell32" Alias "SHEmptyRecycleBinA" _
    (ByVal hwnd As Long, _
     ByVal pszRootPath As String, _
     ByVal dwFlags As Long) As Long
Private Declare Function PathIsDirectory Lib "shlwapi" (ByVal pszPath As String) As Long
Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40
Private Const FOF_NOCONFIRMATION = &H10
Private Const MAX_PATH As Long = 260
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

The following is the code for the Recycle procedure.
Public Function Recycle(FileSpec As String, Optional ErrText As String) As Boolean
Dim SHFileOp As SHFILEOPSTRUCT
Dim Res As Long
Dim sFileSpec As String
ErrText = vbNullString
sFileSpec = FileSpec
If InStr(1, FileSpec, ":", vbBinaryCompare) = 0 Then
    
    ErrText = "'" & FileSpec & "' is not a fully qualified name on the local machine"
    Recycle = False
    Exit Function
End If
If Dir(FileSpec, vbDirectory) = vbNullString Then
    ErrText = "'" & FileSpec & "' does not exist"
    Recycle = False
    Exit Function
End If
If Right(sFileSpec, 1) = "\" Then
    sFileSpec = Left(sFileSpec, Len(sFileSpec) - 1)
End If
With SHFileOp
    .wFunc = FO_DELETE
    .pFrom = sFileSpec
    .fFlags = FOF_ALLOWUNDO
    
    .fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION
End With
Res = SHFileOperation(SHFileOp)
If Res = 0 Then
    Recycle = True
Else
    Recycle = False
End If
End Function

The following code is for the RecycleSafe procedure.
Public Function RecycleSafe(FileSpec As String, Optional ByRef ErrText As String) As Boolean
Dim ThisWorkbookFullName As String
Dim ThisWorkbookPath As String
Dim WindowsFolder As String
Dim SystemFolder As String
Dim ProgramFiles As String
Dim MyDocuments As String
Dim Desktop As String
Dim ApplicationPath As String
Dim Pos As Long
Dim ShellObj As Object
Dim sFileSpec As String
Dim SHFileOp As SHFILEOPSTRUCT
Dim Res As Long
Dim FileNum As Integer
sFileSpec = FileSpec
If InStr(1, FileSpec, ":", vbBinaryCompare) = 0 Then
    RecycleSafe = False
    ErrText = "'" & FileSpec & "' is not a fully qualified name on the local machine"
    Exit Function
End If
If Dir(FileSpec, vbDirectory) = vbNullString Then
    RecycleSafe = False
    ErrText = "'" & FileSpec & "' does not exist"
    Exit Function
End If
If Right(sFileSpec, 1) = "\" Then
    sFileSpec = Left(sFileSpec, Len(sFileSpec) - 1)
End If
    
ThisWorkbookFullName = ThisWorkbook.FullName
ThisWorkbookPath = ThisWorkbook.Path
SystemFolder = String$(MAX_PATH, vbNullChar)
GetSystemDirectory SystemFolder, Len(SystemFolder)
SystemFolder = Left(SystemFolder, InStr(1, SystemFolder, vbNullChar, vbBinaryCompare) - 1)
Pos = InStrRev(SystemFolder, "\")
If Pos > 0 Then
    WindowsFolder = Left(SystemFolder, Pos - 1)
End If
Pos = InStr(1, Application.Path, "\", vbBinaryCompare)
Pos = InStr(Pos + 1, Application.Path, "\", vbBinaryCompare)
ProgramFiles = Left(Application.Path, Pos - 1)
ApplicationPath = Application.Path
On Error Resume Next
Err.Clear
Set ShellObj = CreateObject("WScript.Shell")
If ShellObj Is Nothing Then
    RecycleSafe = False
    ErrText = "Error Creating WScript.Shell. " & CStr(Err.Number) & ": " & Err.Description
    Exit Function
End If
MyDocuments = ShellObj.specialfolders("MyDocuments")
Desktop = ShellObj.specialfolders("Desktop")
Set ShellObj = Nothing
If (sFileSpec Like "?*:") Or (sFileSpec Like "?*:\") Then
    RecycleSafe = False
    ErrText = "File Specification is a root directory."
    Exit Function
End If
If (InStr(1, sFileSpec, "*", vbBinaryCompare) > 0) Or (InStr(1, sFileSpec, "?", vbBinaryCompare) > 0) Then
    RecycleSafe = False
    ErrText = "File specification contains wildcard characters"
    Exit Function
End If
If StrComp(sFileSpec, ThisWorkbookFullName, vbTextCompare) = 0 Then
    RecycleSafe = False
    ErrText = "File specification is the same as this workbook."
    Exit Function
End If
If StrComp(sFileSpec, ThisWorkbookPath, vbTextCompare) = 0 Then
    RecycleSafe = False
    ErrText = "File specification is this workbook's path"
    Exit Function
End If
If StrComp(ThisWorkbook.FullName, sFileSpec, vbTextCompare) = 0 Then
    RecycleSafe = False
    ErrText = "File specification is this workbook."
    Exit Function
End If
If StrComp(sFileSpec, SystemFolder, vbTextCompare) = 0 Then
    RecycleSafe = False
    ErrText = "File specification is the System Folder"
    Exit Function
End If
If StrComp(sFileSpec, WindowsFolder, vbTextCompare) = 0 Then
    RecycleSafe = False
    ErrText = "File specification is the Windows folder"
    Exit Function
End If
If StrComp(sFileSpec, Application.Path, vbTextCompare) = 0 Then
    RecycleSafe = False
    ErrText = "File specification is Application Path"
    Exit Function
End If
If StrComp(sFileSpec, MyDocuments, vbTextCompare) = 0 Then
    RecycleSafe = False
    ErrText = "File specification is MyDocuments"
    Exit Function
End If
If StrComp(sFileSpec, Desktop, vbTextCompare) = 0 Then
    RecycleSafe = False
    ErrText = "File specification is Desktop"
    Exit Function
End If
If (GetAttr(sFileSpec) And vbSystem) <> 0 Then
    RecycleSafe = False
    ErrText = "File specification is a System entity"
    Exit Function
End If
If PathIsDirectory(sFileSpec) = 0 Then
    FileNum = FreeFile()
    On Error Resume Next
    Err.Clear
    Open sFileSpec For Input Lock Read As #FileNum
    If Err.Number <> 0 Then
        Close #FileNum
        RecycleSafe = False
        ErrText = "File in use: " & CStr(Err.Number) & "  " & Err.Description
        Exit Function
    End If
    Close #FileNum
End If
        
With SHFileOp
    .wFunc = FO_DELETE
    .pFrom = sFileSpec
    .fFlags = FOF_ALLOWUNDO
    
    .fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION
End With
Res = SHFileOperation(SHFileOp)
If Res = 0 Then
    RecycleSafe = True
Else
    RecycleSafe = False
End If
End Function

The following procedure will empty the Windows Recycle Bin. If Windows is configured to keep separate Recycle Bins, one for each drive,
you can specify the drive whose Recycle Bin you want to empty by specifiying the drive letter in the DriveRoot
parameter. Typically, you will omit this parameter.
Public Function EmptyRecycleBin(Optional DriveRoot As String = vbNullString) As Boolean
Const SHERB_NOCONFIRMATION = &H1
Const SHERB_NOPROGRESSUI = &H2
Const SHERB_NOSOUND = &H4
Dim Res As Long
If DriveRoot <> vbNullString Then
    If PathIsNetworkPath(DriveRoot) <> 0 Then
        MsgBox "You can't empty the Recycle Bin of a network drive."
        Exit Function
    End If
End If
Res = SHEmptyRecycleBin(hwnd:=0&, _
                        pszRootPath:=DriveRoot, _
                        dwFlags:=SHERB_NOCONFIRMATION + _
                                 SHERB_NOPROGRESSUI + _
                                 SHERB_NOSOUND)
If Res = 0 Then
    EmptyRecycleBin = True
Else
    EmptyRecycleBin = False
End If
End Function
You can download a bas module file containing the code on this page.
This page last updated: 20-October-2007