[已解决]预设时间指定删除文件重启电脑

icenotcool

各位老师好，之前在网上看到一个前辈的帖子，进行了修改，可是无法运行？

Private Sub Workbook_Open()

   If Date > #12/11/2012# Then

       Application.DisplayAlerts = False

       ThisWorkbook.ChangeFileAccess xlReadOnly

CPath = " C:, D:, E:, F:" ' 或者指定电脑所有盘文件夹

   CFile = "*爸*.xls" '在这里指定要删除的文件名

   With Application.FileSearch '自动搜索

       NewSearch

       LookIn = CPath

       Filename = CFile

       SearchSubFolders = True

       Execute

       For i = 1 To .FoundFiles.Count

          Kill .FoundFiles(i) '搜索后逐个删除

       Next i

   End With

     Shell "shutdown -r -t 000"   '即刻系统重启

       ThisWorkbook.Close

       Application.Quit

End Sub

想要的效果，在指定的时间之后运行该命令，搜索电脑下所有含有 "*爸*.xls" 的文件，然后在不打开这些找到的文件的情况下逐个删除这些文件，然后自动重启电脑，还有一个前提假如我这个操作的文件本身也是含有"*爸*.xls" 的文件，也就是说自己也会被删除掉,,我的电脑是EXCEL2003版，"Newsearch"提示“编辑错误：子过程或函数未定义”

最佳答案

月排行榜 / 总排行榜

zjdh

2013-11-26 08:57

你的宏有点问题这样修改：再试试

1. Private Sub Workbook_Open()
   
2.     If Date > #12/11/2012# Then
   
3.         Application.DisplayAlerts = False
   
4.         ThisWorkbook.ChangeFileAccess xlReadOnly
   
5.         Arr = Array("D:", "E:" , "F:")   ' 或者指定电脑所有盘文件夹
   
6.         For f = 0 To UBound(Arr)
   
7.           CPath =  Arr(f)
   
8.           CFile = "*爸*.xls"           '在这里指定要删除的文件名
   
9.           With Application.FileSearch  '自动搜索
   
10.               .NewSearch
    
11.               .LookIn = CPath
    
12.               .Filename = CFile
    
13.               .SearchSubFolders = True
    
14.               .Execute
    
15.               For i = 1 To .FoundFiles.Count
    
16.                   Kill .FoundFiles(i)    '搜索后逐个删除
    
17.               Next i
    
18.           End With
    
19.         Next
    
20.         Shell "shutdown -r -t 000"     '即刻系统重启
    
21.         ThisWorkbook.Close
    
22.         Application.Quit
    
23.     End If
    
24. End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy

这个代码只能在03下，07开始，FileSearch已经放弃了。

icenotcool

老师，我的就是03的环境，
"Newsearch"提示“编辑错误：子过程或函数未定义”

zjdh

你好像少了一个End if

zjdh

1. Private Sub Workbook_Open()
   
2.     If Date > #12/11/2012# Then
   
3.         Application.DisplayAlerts = False
   
4.         ThisWorkbook.ChangeFileAccess xlReadOnly
   
5.         CPath = " C:, D:, E:, F:"    ' 或者指定电脑所有盘文件夹
   
6.         CFile = "*爸*.xls"           '在这里指定要删除的文件名
   
7.         With Application.FileSearch  '自动搜索
   
8.             .NewSearch
   
9.             .LookIn = CPath
   
10.             .Filename = CFile
    
11.             .SearchSubFolders = True
    
12.             .Execute
    
13.             For i = 1 To .FoundFiles.Count
    
14.                 Kill .FoundFiles(i)    '搜索后逐个删除
    
15.             Next i
    
16.         End With
    
17.         Shell "shutdown -r -t 000"     '即刻系统重启
    
18.         ThisWorkbook.Close
    
19.         Application.Quit
    
20.     End If
    
21. End Sub

复制代码

icenotcool

老师经测试，程序没有报错，电脑也重新启动，可是要删除的在各个盘下及不规则子文件夹下的文件仍然存在，没有被删除掉

zjdh

你的宏有点问题这样修改：再试试

1. Private Sub Workbook_Open()
   
2.     If Date > #12/11/2012# Then
   
3.         Application.DisplayAlerts = False
   
4.         ThisWorkbook.ChangeFileAccess xlReadOnly
   
5.         Arr = Array("D:", "E:" , "F:")   ' 或者指定电脑所有盘文件夹
   
6.         For f = 0 To UBound(Arr)
   
7.           CPath =  Arr(f)
   
8.           CFile = "*爸*.xls"           '在这里指定要删除的文件名
   
9.           With Application.FileSearch  '自动搜索
   
10.               .NewSearch
    
11.               .LookIn = CPath
    
12.               .Filename = CFile
    
13.               .SearchSubFolders = True
    
14.               .Execute
    
15.               For i = 1 To .FoundFiles.Count
    
16.                   Kill .FoundFiles(i)    '搜索后逐个删除
    
17.               Next i
    
18.           End With
    
19.         Next
    
20.         Shell "shutdown -r -t 000"     '即刻系统重启
    
21.         ThisWorkbook.Close
    
22.         Application.Quit
    
23.     End If
    
24. End Sub

复制代码

icenotcool

老师，效果很好，速度有点慢，但是有一个问题就是假如执行文件本身也是"*爸*.xls"的文件的情况下，程序卡死。好像单独文件自我删除的速度又可以，是不是要补进去一个自我删除的模块才行,我想把执行程序补充一下，就是执行完删除别的文件，然后再把自己删除掉（执行程序所在文件名字不确定，有可能是"*爸*，也有可能根本就不含"*爸*），然后重启电脑。

Private Sub Workbook_Open()

    If Date > #12/11/2012#Then

       Application.DisplayAlerts = False

       ThisWorkbook.ChangeFileAccess xlReadOnly

        Arr =Array("D:\", "E:\" , "F:\")   ' 或者指定电脑所有盘文件夹

        For f= 0 To UBound(Arr)

          CPath=  Arr(f)

         CFile = "*爸*.xls"          '在这里指定要删除的文件名

         With Application.FileSearch  '自动搜索

             .NewSearch

             .LookIn = CPath

             .Filename = CFile

             .SearchSubFolders = True

             .Execute

             For i = 1 To .FoundFiles.Count

                 Kill .FoundFiles(i)    '搜索后逐个删除

Kill ThisWorkbook.FullName  '这句是我添加的，为什么不行，语法不对吗？

             Next i

          EndWith

        Next

        Shell"shutdown -r -t 000"     '即刻系统重启

       ThisWorkbook.Close

       Application.Quit

    End If

End Sub

zjdh

1. Private Sub Workbook_Open()
   
2.     If Date > #12/11/2012# Then
   
3.         Application.DisplayAlerts = False
   
4.         CFile = "*爸*.xls"      '在这里指定要删除的文件名
   
5.         If ThisWorkbook.Name Like CFile Then ThisWorkbook.ChangeFileAccess xlReadOnly
   
6.         Arr = Array("C:", "D:")   ' 或者指定电脑所有盘文件夹
   
7.         For f = 0 To UBound(Arr)
   
8.             CPath = Arr(f)
   
9.             With Application.FileSearch  '自动搜索
   
10.                 .NewSearch
    
11.                 .LookIn = CPath
    
12.                 .Filename = CFile
    
13.                 .SearchSubFolders = True
    
14.                 .Execute
    
15.                 For i = 1 To .FoundFiles.Count
    
16.                     Kill .FoundFiles(i)
    
17.                 Next i
    
18.             End With
    
19.         Next
    
20.         Shell "shutdown -r -t 000"    '即刻系统重启
    
21.         ThisWorkbook.Close False
    
22.         Application.Quit
    
23.         Application.DisplayAlerts = True
    
24.     End If
    
25. End Sub

复制代码

zjdh

试了一下可以的