复制内容到剪贴板
代码:
'函数名称: DelFiles(文件路径[,文件扩展名=".*"][,是否删除所有文件])
'举 例: DelFiles("C:\Windows\Temp\",".*",True)
'作 用: 获取路径的最后一个文件夹名
Public Function DelFiles(dPath As String, Optional FileExt As String = ".*", Optional AllFile As Boolean = False)
On Error Resume Next
Dim k As Integer, i As Integer
Dim tmpFilePath As String, Num() As String
Dim ClipNum() As String
ClipNum = Split(FindClips(dPath), Chr(0))
Num = Split(FindPathFiles(dPath, FileExt), Chr(0))
For i = 0 To UBound(Num) - 1
Debug.Print "状态:正在删除目录 [" & OverClip(dPath) & "] 下的 " & Num(i) & " 文件" & IIf(Err, " [" & Err.Description & "]", "") & vbCrLf
Debug.Print "状态:" & dPath & Num(i)
SetAttr dPath & Num(i), 0 '设置只读文件属性
Kill dPath & Num(i) '删除文件
DoEvents
Next i
For k = 0 To UBound(ClipNum) - 1
tmpFilePath = dPath & ClipNum(k) & "\"
If AllFile = True Then Call DelFiles(tmpFilePath, FileExt, True) '是否删除该目录下的子文件夹
tmpFilePath = dPath & ClipNum(k)
Num = Split(FindPathFiles(tmpFilePath, FileExt), vbCrLf)
For i = 0 To UBound(Num) - 1
Debug.Print "状态:正在删除目录 [" & ClipNum(k) & "] 下的 " & Num(i) & " 文件" & IIf(Err, " [" & Err.Description & "]", "")
Debug.Print "状态:" & tmpFilePath & Num(i)
SetAttr tmpFilePath & Num(i), 0 '设置只读文件属性
Kill tmpFilePath & Num(i) '删除文件
DoEvents
Next i
If AllFile = True Then
Debug.Print "状态:正在删除目录 [" & ClipNum(k) & "]" & IIf(Err, " [" & Err.Description & "]", "")
RmDir tmpFilePath '删除文件夹
End If
DoEvents
Next k
End Function
'函数名称: FindClips(文件路径)
'举 例: FindClips("C:\")
'作 用: 查找当前路径下的所有目录
Public Function FindClips(tmpPath As String) As String
On Error Resume Next
Dim ClipName As String, tmp As String
Dim ClipPath As String
tmp = ""
ClipPath = IIf(Right(tmpPath, 1) <> "\", tmpPath & "\", tmpPath) ' 指定路径。
ClipName = Dir(ClipPath, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem) ' 找寻第一项。
While ClipName <> "" ' 开始循环。
' 跳过当前的目录及上层目录。
If ClipName <> "." And ClipName <> ".." Then
' 使用位比较来确定 ClipName 代表一目录。
If (GetAttr(ClipPath & ClipName) And vbDirectory) = vbDirectory Then _
tmp = tmp & ClipName & Chr(0) ' 如果它是一个目录，将其名称显示出来。
End If
ClipName = Dir ' 查找下一个目录。
Wend
FindClips = tmp
End Function
'函数名称: FindPathFiles(文件路径[,.扩展名])
'举 例: FindPathFiles("C:\")
'举 例: FindPathFiles("C:\",".EXE")
'作 用: 查找当前文件夹下的所有文件
Public Function FindPathFiles(TmpFileClip As String, Optional FileExt As String = ".*") As String
Dim FileClip As String
Dim TmpNum() As String, tmp As String, tmpPath As String
Dim i As Integer, tmpInt As Long
On Error GoTo ErrMsg: '发生错误跳到ErrMsg:
FileClip = IIf(Right(TmpFileClip, 1) = "\", TmpFileClip, TmpFileClip & "\") '路径处理
tmp = ""
tmpPath = Dir(FileClip & "*" & FileExt, vbHidden Or vbNormal Or vbReadOnly)
While tmpPath <> "" '循环获取文件名(带路径)不需要路径可以把 CheckStr(FileClip, TmpInt) & 删除
'tmpInt = InStrRev(tmpPath, ".") 'iif(mid(tmpPath,tmpInt+1,len(tmpPath))=
tmp = tmp & tmpPath & Chr(0)
tmpPath = Dir
DoEvents
Wend
FindPathFiles = tmp
Exit Function
ErrMsg:
FindPathFiles = Err.Description
End Function
'函数名称: OverClip(文件路径)
'举 例: OverClip("C:\Windows\")
'作 用: 获取路径的最后一个文件夹名
Public Function OverClip(oPath As String) As String
Dim Num As Integer, Max As Integer, oClip As String
oPath = IIf(Right(oPath, 1) = "\", oPath, oPath & "\")
Max = Len(oPath)
oClip = Left(oPath, Max - 1)
Num = InStrRev(oClip, "\") + 1
oClip = Mid(oClip, Num, Max - Num)
OverClip = IIf(Len(oClip) = 2, Left(oClip, 1) & "盘", oClip)
End Function[hide][/hide]
