2017-09-22 55 views
1

使用下面的代碼刪除我的文件,但它不會進入回收站 - 是否存在將它發送到回收站的代碼?我應該使用「.Move」嗎?訪問VBA將文件刪除到回收站?

If MsgBox("DELETE:" & Chr(10) & Forms("frmtbl").f_FullPath & Me.f_FileName & " ?", vbYesNo) = vbYes Then 
     'Kill Forms("frmtbl").f_FullPath & Me.f_FileName 
     Dim objFSO As Object 
     Set objFSO = CreateObject("Scripting.FileSystemObject") 
     objFSO.DeleteFile (Forms("frmtbl").f_FullPath & Me.f_FileName) 
     DoCmd.Close acForm, Me.Name 
Else 
     MsgBox "FILE NOT DELETED:" & Chr(10) & Forms("frmtbl").f_FullPath & Me.f_FileName & ".", vbInformation, 
End If 

.MoveFile回收站需要權限我沒有。

回答

1

集成的VBA方法似乎不存在。 API調用是必需的。

以下代碼複製自reddit。 (通過「Crushnaut」的解決方案)

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