SHFileOperationA function (shellapi.h)
Copies, moves, renames, or deletes a file system object. This function has been replaced in Windows Vista by IFileOperation.
Further reference: https://docs.microsoft.com/en-us/windows/win32/api/shellapi/nf-shellapi-shfileoperationa
Sub Test_FileSpec() Recycle "C:\somepath\file.ext" End Sub
'-------------------------------
'Sumitted by: @Husky Passion
'-------------------------------
Option Explicit '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Windows API functions, constants,and types. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Declare PtrSafe Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As LongPtr 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 LongPtr wFunc As LongPtr pFrom As String pTo As String fFlags As Integer fAnyOperationsAborted As Boolean hNameMappings As LongPtr lpszProgressTitle As String End Type Public Function Recycle(FileSpec As String, Optional ErrText As String) As Boolean ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Recycle ' This function sends FileSpec to the Recycle Bin. There ' are no restriction on what can be recycled. FileSpec ' must be a fully qualified folder or file name on the ' local machine. ' The function returns True if successful or False if ' an error occurs. If an error occurs, the reason for the ' error is placed in the ErrText variable. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim SHFileOp As SHFILEOPSTRUCT Dim Res As LongPtr Dim sFileSpec As String ErrText = vbNullString sFileSpec = FileSpec If InStr(1, FileSpec, ":", vbBinaryCompare) = 0 Then '''''''''''''''''''''''''''''''''''''' ' Not a fully qualified name. Get out. '''''''''''''''''''''''''''''''''''''' 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 '''''''''''''''''''''''''''''''''''' ' Remove trailing '\' if required. '''''''''''''''''''''''''''''''''''' If Right(sFileSpec, 1) = "\" Then sFileSpec = Left(sFileSpec, Len(sFileSpec) - 1) End If On Error Resume Next With SHFileOp .wFunc = FO_DELETE .pFrom = sFileSpec '.fFlags = FOF_ALLOWUNDO ''''''''''''''''''''''''''''''''' ' If you want to supress the ' "Are you sure?" message, use ' the following: ''''''''''''''''''''''''''''''' .fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION End With Res = SHFileOperation(SHFileOp) If Res = 0 Then Recycle = True Else Recycle = False End If Err.Clear: On Error GoTo 0 End Function
Option Explicit Sub test1() Kill "C:\Users\LP\Desktop\demo\file.txt" End Sub Sub test2() Kill "C:\Users\LP\Desktop\demo\New Microsoft Excel Worksheet.xlsx" End Sub Sub test3() Dim fsObj As New FileSystemObject Dim strPath As String strPath = "C:\Users\LP\Desktop\demo\sub1" 'If fsObj.FolderExists(strPath) = True Then ' fsObj.DeleteFolder strPath 'End If ' ' 'fsObj.DeleteFile strPath & "\*.txt", True 'fsObj.DeleteFolder strPath & "\*.*", True End Sub
No comments:
Post a Comment
Note: only a member of this blog may post a comment.