'删除文档的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
'fFlag 常数
Const FOF_ALLOWUNDO = &H40 '允许 Undo 。
Const FOF_NOCONFIRMATION = &H10 '不显示系统确认对话框。
Const FOF_NOCONFIRMMKDIR = &H200 '不提示是否新建目录。
Const FOF_SILENT = &H4 '不显示进度对话框。
Const FOF_FILESONLY = &H80 '执行通配符,只执行文件。
Const FOF_NOERRORUI = &H400 '当文件处理过程中出现错误时,不出现错误提示。
Const FOF_RENAMEONCOLLISION = &H8 '当已存在文件名时,对其进行更换文提示。
Public Const FO_DELETE = &H3
Public Const SHERB_NORMAL = &H0
Public Const SHERB_NOCONFIRMATION = &H1 '表示不显示确认视窗
Public Const SHERB_NOPROGRESSUI = &H2 '表示不显示清空资源回收站的动画视窗 (经测试98原本已不会出现动画)
Public Const SHERB_NOSOUND = &H4 '表示清空资源回收站之后不出现声音
Public Sub RunTest()
DelFileToBin "d:\temp\aaa.xls"
End Sub
'===========================================================
' 过程及函数名: DelFileToBin
' 版本号 : --
' 说明 : 将文档移至回收站。
' 测试环境 : win2003+office2007 chs
' 引用 : --
' 输入参数 : fileFullName 文件全名,包括路径
' 输出值 : --
' 返回值 : API 执行的结果
' 0 没错误
' 32 文件正在被占用
' 1026 文件不存在
' 调用演示 : DelFileToBin "d:\temp\aaa.xls"
' 最后修改日期: 2008-2-28 23:36:00
' 作者 : 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
' FO_COPY: 拷贝文件pFrom到pTo 的指定位置?
' FO_RENAME: 将pFrom的文件名更名为pTo的文件名?
' FO_MOVE: 将pFrom的文件移动到pTo的地方?
' FO_DELETE: 删除pFrom指定的文件?
'
' 使用该函数进行文件拷贝、移动或删除时,如果需要的时间很长,则程序会自动在进行的过程中出现一个无模式的对话框(Windows操作系统提供的文件操作对话框),用来显示执行的进度和执行的时间,以及正在拷贝、移动或删除的文件名,此时结构中的成员lpszProgressTitle显示此对话框的标题。fFlags是在进行文件操作时的过程和状态控制标识。它主要有如下一些标识,也可以是其组合:
'
' FOF_FILESONLY:执行通配符,只执行文件;
' FOF_ALLOWUNDO:保存UNDO信息,以便在回收站中恢复文件;
' FOF_NOCONFIRMATION:在出现目标文件已存在的时候,如果不设置此项,则它会出现确认是否覆盖的对话框,设置此项则自动确认,进行覆盖,不出现对话框。
' FOF_NOERRORUI:设置此项后,当文件处理过程中出现错误时,不出现错误提示,否则会进行错误提示。
' FOF_RENAMEONCOLLISION:当已存在文件名时,对其进行更换文提示。
' FOF_SILENT: 不显示进度对话框?
' FOF_WANTMAPPINGHANDLE:要求SHFileOperation()函数返回正处于操作状态的实际文件列表,文件列表名柄保存在hNameMappings成员中。
' SHFILEOPSTRUCT结构还包含一个SHNAMEMAPPING结构的数组,此数组保存由SHELL计算的每个处于操作状态的文件的新旧路径。
'
' 在使用该函数删除文件时必须设置SHFILEOPSTRUCT结构中的神秘FOF_ALLOWUNDO标志,这样才能将待删除的文件拷到Recycle Bin,从而使用户可以撤销删除操作。需要注意的是,如果pFrom设置为某个文件名,用FO_DELETE标志删除这个文件并不会将它移到Recycle Bin,甚至设置FOF_ALLOWUNDO标志也不行,在这里你必须使用全路径名,这样SHFileOperation才会将删除的文件移到Recycle Bin。
|