DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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 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
'
Sub Test()
Dim myFile As String
myFile = ThisWorkbook.Path & "\listeler.xlsx"
Call Recycle(myFile)
End Sub
'
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 varaible.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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
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
End Function
