Recycle A File Or Folder
Sending A File To The Recycle Bin
This page has been replaced. Kill "C:\Temp\Test.txt" You need to remember, though, that Kill permanently deletes the file. There is no way to "undo" the delete. The file is not sent to the Windows Recycle Bin. VBA does not provide a built-in way to send a file to the Recycle Bin, but with a call to a Windows API (Application Programming Interface) procedure, you can send a file to the Recycle Bin. To delete the contents of a folder (all file and subfolders), but leave the folder intact, see the Empty Folder page. The function below will send the file or folder identified by FileSpec to the Recycle Bin, with following restrictions.
Additionally, the code prevents you from deleting the following folders, although you can delete file or folders within these folders:
The code below will delete a file or folder, and return a result of True or False indicating the success of the operation. If the recycle operation was not successfully carried out, the public variable G_RecycleErrorText will contain an error message describing why the specified file or folder could not be send to the Windows Recycle Bin. The code is shown below. You can download a bas module file here. Option Explicit Option Compare Text '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' modRecycle ' By Chip Pearson, www.cpearson.com , chip@cpearson.com ' This contains function for sending files and folder to the Windows Recycle Bin. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''' ' Error message text is put in this ' variable which describes the ' reason that RecycleFileOrFolder ' return a False result. ''''''''''''''''''''''''''''''''''' Public G_RecycleErrorText As String '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Windows API functions, constants,and types. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 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 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 Public Function RecycleFileOrFolder(FileSpec As String) As Boolean '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' RecycleFileOrFolder ' This procedure sends FileSpec to the Windows Recycle Bin. It returns True if ' successful or False if an error occurred. ' ' FileSpec must be the fully qualified file name on a local drive (not a mapped ' drive or a network share). FileSpec may be either a file name or a folder name. ' ' An error will occurred and the funciton will return False ' if any of the following are true: ' ------------------------------------------------------------- ' FileSpec does not exist ' FileSpec is not a fully qualified file name (including Drive and Path ' information) ' FileSpec contains the wildcard characters '*' or '?'. ' FileSpec is in use by another process ' FileSpec is a System folder (however, files within a system folder ' may be recycled). ' FileSpec is ThisWorkbook. ' FileSpec is ThisWorkbook.Path ' FileSpec is a root directory of any drive ' ' Also, the following folders may not be recycled (although a file within ' these folder may be recycled): ' ----------------------------------------------------------- ' C:\Windows\System32 ' returned by GetSystemDirectory ' C:\Windows ' parent of GetSystemDirectory ' C:\Program Files ' top level folder of Application.Path ' C:\<user-profile>\My Documents ' C:\<user-profile>\Desktop ' Application.Path ' ThisWorkbook.Path ' ' A text description of the error is placed in the G_RecycleErrorText variable. ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim FileOperation As SHFILEOPSTRUCT Dim lReturn As Long Dim Attr As VbFileAttribute Dim SystemFolder As String Dim WindowsFolder As String Dim ProgramFilesFolder As String '* Dim MyDocumentsFolder As String '* Dim ThisWorkbookFolder As String Dim DesktopFolder As String '* Dim ShellObj As Object Dim Pos As Integer Dim sFileSpec As String Dim ProtectedFolders(1 To 7) As String Const C_ARR_WINDOWS = 1 Const C_ARR_WINDOWS_SYSTEM32 = 2 Const C_ARR_PROGRAM_FILES = 3 Const C_ARR_MYDOCUMENTS = 4 Const C_ARR_DESKTOP = 5 Const C_ARR_APP_PATH = 6 Const C_ARR_THISWORKBOOK_PATH = 7 G_RecycleErrorText = vbNullString sFileSpec = Trim(FileSpec) ''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Ensure we weren't passed a empty string ''''''''''''''''''''''''''''''''''''''''''''''''''''' If Trim(sFileSpec) = vbNullString Then G_RecycleErrorText = "Specified Filename is empty or spaces." RecycleFileOrFolder = False Exit Function End If ''''''''''''''''''''''''''''''''''''''''''''' ' Get rid of trailing slash. ''''''''''''''''''''''''''''''''''''''''''''' If Len(sFileSpec) > 1 Then If Right(sFileSpec, 1) = "\" Then sFileSpec = Left(sFileSpec, Len(sFileSpec) - 1) End If End If ''''''''''''''''''''''''''''''''''''''''''''''''' ' System Folder, typically "C:\Windows\System32" ''''''''''''''''''''''''''''''''''''''''''''''''' SystemFolder = String$(MAX_PATH, vbNullChar) GetSystemDirectory SystemFolder, Len(SystemFolder) SystemFolder = Left(SystemFolder, InStr(1, SystemFolder, vbNullChar, vbBinaryCompare) - 1) ''''''''''''''''''''''''''''''''''''''''''''''''' ' Windows Folder, parent of SystemFolder, ' typically "C:\Windows" ''''''''''''''''''''''''''''''''''''''''''''''''' Pos = InStrRev(SystemFolder, "\", -1, vbBinaryCompare) If Pos > 0 Then WindowsFolder = Left(SystemFolder, Pos - 1) End If ''''''''''''''''''''''''''''''''''''''''''''''''''' ' Program Files. Top directory of Application.Path. ''''''''''''''''''''''''''''''''''''''''''''''''''' Pos = InStr(1, Application.Path, "\", vbBinaryCompare) If Pos > 0 Then Pos = InStr(Pos + 1, Application.Path, "\", vbBinaryCompare) If Pos > 0 Then ProgramFilesFolder = Left(Application.Path, Pos - 1) End If End If ''''''''''''''''''''''''''''''''''''''''''' ' Get an instance of WScript.Shell to ' retreive the "My Documents" and "Desktop" ' folders. ''''''''''''''''''''''''''''''''''''''''''' Set ShellObj = CreateObject("WScript.Shell") '''''''''''''''''''''''''''''''''''''''''''''''''''' ' My Documents '''''''''''''''''''''''''''''''''''''''''''''''''''' MyDocumentsFolder = ShellObj.SpecialFolders("MyDocuments") '''''''''''''''''''''''''''''''''''''''''''''''''''' ' Desktop '''''''''''''''''''''''''''''''''''''''''''''''''''' DesktopFolder = ShellObj.SpecialFolders("Desktop") ''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Load up the array protected folders. None of ' these folders may be recycled, although folders and ' files within these folders may be recycled. ''''''''''''''''''''''''''''''''''''''''''''''''''''' ProtectedFolders(C_ARR_WINDOWS) = WindowsFolder ProtectedFolders(C_ARR_WINDOWS_SYSTEM32) = SystemFolder ProtectedFolders(C_ARR_PROGRAM_FILES) = ProgramFilesFolder ProtectedFolders(C_ARR_MYDOCUMENTS) = MyDocumentsFolder ProtectedFolders(C_ARR_DESKTOP) = DesktopFolder ProtectedFolders(C_ARR_APP_PATH) = Application.Path ProtectedFolders(C_ARR_THISWORKBOOK_PATH) = ThisWorkbook.Path ''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Check if the file or folder exists. ''''''''''''''''''''''''''''''''''''''''''''''''''''' If Dir(sFileSpec, vbNormal + vbArchive + vbSystem _ + vbHidden + vbDirectory) = vbNullString Then G_RecycleErrorText = "The specified file or folder '" & sFileSpec & _ "' does not exist." RecycleFileOrFolder = False Exit Function End If '''''''''''''''''''''''''''''''''''''''''''''''''''' ' Ensure that sFile isn't a network file name. You ' can't recycle network files. '''''''''''''''''''''''''''''''''''''''''''''''''''' If PathIsNetworkPath(sFileSpec) <> 0 Then G_RecycleErrorText = "The specified file or folder '" & sFileSpec & _ "' is on a mapped drive or network share." RecycleFileOrFolder = False Exit Function End If '''''''''''''''''''''''''''''''''''''''''''''''''''' ' Ensure we have a fully qualified file name. That ' means it has a drive specification character (:). '''''''''''''''''''''''''''''''''''''''''''''''''''' If InStr(1, sFileSpec, ":") = 0 Then G_RecycleErrorText = "The specified file or folder '" & sFileSpec _ & "' is not a fully qualified file name." RecycleFileOrFolder = False Exit Function End If '''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Ensure we don't have a root directory. '''''''''''''''''''''''''''''''''''''''''''''''''''''' If (sFileSpec Like "?:\") Or (sFileSpec Like "??:\") Or _ (sFileSpec Like "?:") Or (sFileSpec Like "??:") Then G_RecycleErrorText = "The specified file or folder is a drive root directory." RecycleFileOrFolder = False Exit Function End If If InStr(1, sFileSpec, "?", vbBinaryCompare) Or _ InStr(1, sFileSpec, "*", vbBinaryCompare) Then G_RecycleErrorText = "The file specification '" & sFileSpec & _ "' contains '?' or '*' wildcards." RecycleFileOrFolder = False Exit Function End If ''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Ensure sFileSpec is not a protected directory ' as we define a protected directory. ''''''''''''''''''''''''''''''''''''''''''''''''''''' For Pos = LBound(ProtectedFolders) To UBound(ProtectedFolders) If StrComp(sFileSpec, ProtectedFolders(Pos), vbTextCompare) = 0 Then G_RecycleErrorText = "The specified file or folder '" & sFileSpec & _ "' names a folder that this procedure will not recycle." RecycleFileOrFolder = False Exit Function End If Next Pos '''''''''''''''''''''''''''''''''''''''''''''''''''' ' Ensure we are not dealing with a system file or ' folder. '''''''''''''''''''''''''''''''''''''''''''''''''''' Attr = GetAttr(sFileSpec) If Attr And vbSystem Then G_RecycleErrorText = "The specified file or folder '" & sFileSpec & _ "' is a system file or folder." RecycleFileOrFolder = False Exit Function End If '''''''''''''''''''''''''''''''''''''''''''''' ' Ensure we're not deleting our own directory. '''''''''''''''''''''''''''''''''''''''''''''' If StrComp(sFileSpec, ThisWorkbook.Path, vbTextCompare) = 0 Then G_RecycleErrorText = "The specified file or folder '" & sFileSpec & _ "' refers to ThisWorkbook's Path." RecycleFileOrFolder = False Exit Function End If '''''''''''''''''''''''''''''''''''''''''''''' ' Ensure we're not deleting the application's ' folder. '''''''''''''''''''''''''''''''''''''''''''''' If StrComp(sFileSpec, Application.Path, vbTextCompare) = 0 Then G_RecycleErrorText = "The specified file or folder '" & sFileSpec & _ "' refers to Application's Path." RecycleFileOrFolder = False Exit Function End If With FileOperation .wFunc = FO_DELETE .pFrom = sFileSpec .fFlags = FOF_ALLOWUNDO ' ' OR if you want to suppress the "Do You want ' to delete the file" message, use ' .fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION End With lReturn = SHFileOperation(FileOperation) If lReturn = 0 Then RecycleFileOrFolder = True Else RecycleFileOrFolder = False End If End Function
Recycling An Entire Folder NOTE: When you call RecycleFileOrFolder, you must provide the full folder name, including the drive name and folder path. Otherwise, the file may be permanently deleted and not sent to the Recycle Bin.
Sub EmptyRecycleBin(Optional DriveRoot As String = vbNullString) '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' EmptyRecycleBin ' This procedure empties the Recycle Bin. If your system is configured to ' maintain separate Recycle Bins for each drive, you can specify the DriveRoot ' of the drive whose Recycle Bin you want to empty. If DriveRoot is omitted, ' all the drives' Recycle Bins will be emptied. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 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 Sub End If End If Res = SHEmptyRecycleBin(hwnd:=0&, _ pszRootPath:=DriveRoot, _ dwFlags:=SHERB_NOCONFIRMATION + _ SHERB_NOPROGRESSUI + SHERB_NOSOUND) End Sub |
||