能预防删除后容易根据文件名进行选择恢复的对文件夹及文件的删除

microyip

昨天，有个朋友因为某些特殊原因，需要对文件夹及文件进行删除，问及我，是否可以恢复的，我只能回答，原则上是可以在短期内恢复，但因为涉及删除数量较多，即使恢复都是选择有用的来恢复，所以可以通过改名的方式，令到对方在恢复时也存在难度。
因为文件及文件夹数量太多了，手工一个个去改名，不现实啊，所以写了个代码去处理了。回家后，把代码再整理一遍，顺便注释上，分享给大家。

microyip

1. Private dicPath As Object, dicChar As Object
   
2. Private vSubPath As Variant, sMainPath As String
   
3. 
   
4. Sub 删除文件夹及文件()
   
5.     Dim sPath As String, nI As Long, nJ As Long, sNewName As String, nPath As Long
   
6.    
   
7.     Randomize '初始化随机种子
   
8.     Set dicChar = CreateObject("Scripting.Dictionary") '初始化记录允许用于文件命名的字符的字典
   
9.     sPath = "~!@#$%^&()_+-=`;',.[]{}1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" '允许用于文件命名的字符
   
10.     For nI = 1 To Len(sPath)
    
11.         dicChar(Mid(sPath, nI, 1)) = 0 '建立允许用于文件命名的字符的字典
    
12.     Next
    
13.    
    
14.     sMainPath = [A3].Value '要删除的主文件夹
    
15.     If sMainPath = "" Then Exit Sub '未输入要删除的主文件夹
    
16.     If Right(sMainPath, 1) = "" Then sMainPath = Left(sMainPath, Len(sMainPath) - 1) '清理主输入的文件夹名最后一个斜杠
    
17.     If Dir(sMainPath, vbDirectory) = "" Then '检查主文件夹是否存在
    
18.         MsgBox "输入的主文件夹不存在！“"
    
19.         Exit Sub
    
20.     End If
    
21.    
    
22.     nI = Cells(Rows.Count, 1).End(xlUp).Row '获取A列最后一个单元格的行号
    
23.     If nI = 5 Then '说明只有一个指定子文件夹
    
24.         ReDim vSubPath(1 To 1) '建立单一子文件夹数组
    
25.         vSubPath(1) = [A5].Value
    
26.     ElseIf nI > 4 Then '说明有多个指定子文件夹
    
27.         vSubPath = Application.WorksheetFunction.Transpose([A5].Resize(nI - 4).Value) '获取所有的子文件夹
    
28.     End If
    
29.    
    
30.     Set dicPath = CreateObject("Scripting.Dictionary") '初始化记录用于循环检索子文件夹
    
31.     If IsArray(vSubPath) Then '如果子文件夹变量是数组，说明有指定删除的文件夹
    
32.         For nI = LBound(vSubPath) To UBound(vSubPath)
    
33.             If Dir(sMainPath & "" & vSubPath(nI), vbDirectory) <> "" Then '检查子文件夹存在
    
34.                 dicPath(sMainPath & "" & vSubPath(nI)) = vSubPath(nI)  '字典记录需要查子文件夹的文件夹全称为关键字，子文件夹名为项目值
    
35.             End If
    
36.         Next
    
37.     Else '如果子文件夹变量不是数组，说明要对整个主文件夹进行删除
    
38.         vSubPath = Split(sMainPath, "") '将原主文件夹用\拆出各级文件夹的名称
    
39.         vSubPath = vSubPath(UBound(vSubPath)) '获取主文件夹名
    
40.         sMainPath = Left(sMainPath, Len(sMainPath) - 1 - Len(vSubPath)) '获取主文件的上级文件夹全名
    
41.         dicPath(sMainPath & "" & vSubPath) = vSubPath   '字典记录需要查子文件夹的文件夹全称为关键字，子文件夹名为项目值
    
42.     End If
    
43.    
    
44.     Do While nPath < dicPath.Count '字典关键字序号小于字典总数
    
45.         sPath = dicPath.Keys()(nPath) '获取字典第nPath个需要检索的文件夹名
    
46.         SearchDir sPath '检索该文件夹内的文件及子文件夹
    
47.         nPath = nPath + 1
    
48.     Loop
    
49.    
    
50.     Do While dicPath.Count > 0 '文件夹字典总数大于0，说明还有文件夹没有删除
    
51.         sMainPath = dicPath.Keys()(dicPath.Count - 1) '从最后一个文件夹开始删除，获取删除的文件夹全称
    
52.         sPath = dicPath(sMainPath) '获取删除的子文件夹名
    
53.         dicPath.Remove sMainPath '清除字典内文件夹名
    
54.         sMainPath = Left(sMainPath, Len(sMainPath) - Len(sPath)) '获取子文件夹上级文件夹全称
    
55.         sNewName = GetFileName '获取改名用的新名
    
56.         Name sMainPath & sPath As sMainPath & sNewName  '将子文件夹进行改名
    
57.         RmDir sMainPath & sNewName '删除文件夹
    
58.     Loop
    
59.     MsgBox "删除完毕！"
    
60. End Sub
    
61. 
    
62. Sub SearchDir(ByVal sPath As String)
    
63. '对指定文件夹进行检索文件及子文件夹
    
64.     Dim sFile As Variant, nI As Long, sNewName As String
    
65.    
    
66.     sPath = sPath & ""
    
67.     sFile = Dir(sPath & "*.*", vbDirectory + vbSystem + vbHidden) '检索文件夹内所有文件夹及文件
    
68.     Do While sFile <> ""
    
69.         If sFile <> "." And sFile <> ".." Then
    
70.             If (GetAttr(sPath & sFile) And vbDirectory) = vbDirectory Then
    
71.                 If (GetAttr(sPath & sFile) And vbHidden) = vbHidden Then '如果是系统隐藏文件夹
    
72.                     SetAttr sPath & sFile, vbNormal '设置文件为正常文件夹
    
73.                 End If
    
74.                 dicPath(sPath & sFile) = sFile  '记录到文件夹字典
    
75.             Else
    
76.                 If (GetAttr(sPath & sFile) And (vbSystem + vbHidden)) = vbSystem + vbHidden Then '如果是系统隐藏文件
    
77.                     SetAttr sPath & sFile, vbNormal '设置文件为正常文件
    
78.                     sNewName = sFile
    
79.                 Else
    
80.                     sNewName = GetFileName '获取改名用的新名
    
81.                     If (GetAttr(sPath & sFile) And vbHidden) = vbHidden Then '如果是隐藏文件
    
82.                         SetAttr sPath & sFile, vbNormal '设置文件为正常文件
    
83.                     End If
    
84.                     Name sPath & sFile As sPath & sNewName '文件改名
    
85.                 End If
    
86.                 Kill sPath & sNewName '删除文件
    
87.             End If
    
88.         End If
    
89.         sFile = Dir '检索下一个文件夹或文件
    
90.     Loop
    
91. End Sub
    
92. 
    
93. Private Function GetFileName() As String
    
94. '建立随机文件名
    
95.     Dim nI As Long, nLen As Long, sFile As String
    
96.    
    
97.     nLen = Int(30 * Rnd) + 20 '获取一个大于大于20，小于50的长度
    
98.     For nI = 1 To nLen
    
99.         sFile = sFile & dicChar.Keys()(Int((dicChar.Count - 1) * Rnd)) '随机取一个允许字符加到文件名
    
100.     Next
     
101.     GetFileName = sFile
     
102. End Function

复制代码

microyip

留一层楼作为以后可能会补充些什么

wangsp

感谢分享！论坛有您更精彩~~

xkzb

感谢分享，我拿来用正好