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