'删除文档的API
Private Declare Function SHFileOperation Lib "shell32.dll" _
Alias "SHFileOperationA" (lpFileOp As ToBin) As Long
'清空回收站的API
Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" _
Alias "SHEmptyRecycleBinA" (ByVal hwnd As Long, ByVal pszRootPath As String, ByVal dwFlags As Long) As Long
Private Type ToBin
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As Long
End Type
' 作者 : cg1
' 网站 : http://access911.net
' 电子邮件 : access911@gmail.com
' 版权 : 作者保留一切权力,
' 请在公布本代码时将本段说明一起公布,谢谢!
'===========================================================
Public Function DelFileToBin(ByVal fileFullName As String) As Long
Dim objToBin As ToBin
Dim strFile As String
Dim lngResult As Long
strFile = fileFullName
With objToBin
.wFunc = FO_DELETE
.pFrom = strFile
.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION + FOF_NOERRORUI
End With
'注意,以下操作将会弹出对话框要求用户确认
lngResult = SHFileOperation(objToBin)
DelFileToBin = lngResult
Select Case lngResult
Case 1026
'该文件或者资源不存在
Case 0
'在未设置 FOF_NOCONFIRMATION 时可能有两种情况
'删除成功,或者用户取消删除。未出现错误都返回0
If Dir(strFile) <> "" Then
'客户取消了删除
Else
'删除成功
End If
Case 32
'需要删除的文件正在被占用
Case Else
'其他错误
End Select
End Function
'清空回收站
Private Sub ClsBin()
Dim RetVal As Long
RetVal = SHEmptyRecycleBin(0&, vbNullString, SHERB_NORMAL)
End Sub