请高手探讨关于指定文件夹删除VB代码的问题

高飞扬

附件中指定文件夹删除VB代码有2个问题，想请高手老师研究解决：
1. 当工作簿和VB 都带密码时，执行会出错，直接程序死掉；
2. 执行时只能执行一个文件夹，不能够对文件夹中的子文件乃至子文件夹中的文件执行。
求解决，谢谢！
指定文件夹删除代码.zip (11.88 KB, 下载次数: 21)

2014-10-15 16:50 上传

点击文件名下载附件

高飞扬

没有老师愿意指点一下么？

lsdongjh

密码的问题，我机子上无法调试，第二个是遍历的问题：

1. Option Explicit
   
2. 
   
3. Dim ArrFiles(1 To 10000) As String '创建一个数组空间,用来存放文件名称
   
4. Dim cntFiles As Long '文件个数
   
5. 
   
6. Public Sub ListAllFiles()
   
7.     Dim strPath As String '声明文件路径
   
8.     Dim i As Long
   
9.    
   
10.     Dim fso As New FileSystemObject, fd As Folder '创建一个FileSystemObject对象和一个文件夹对象
    
11.    
    
12.     With Application.FileDialog(msoFileDialogFolderPicker)
    
13.         If .Show Then strPath = .SelectedItems(1) Else Exit Sub '对话框取得文件夹,设置要遍历的文件夹目录
    
14.     End With
    
15. 
    
16.     cntFiles = 0
    
17.     Set fd = fso.GetFolder(strPath) '设置fd文件夹对象
    
18.     SearchFiles fd '调用子程序查搜索文件
    
19.    
    
20.     '你可以在这里操作你的文件
    
21.     '所有符合条件的文件名均在 ArrFiles 数组中
    
22.    
    
23.     Sheets(1).Range("A1").Resize(cntFiles) = Application.Transpose(ArrFiles) '把数组内的路径和文件名放在单元格中
    
24. End Sub
    
25. Sub SearchFiles(ByVal fd As Folder)
    
26.     Dim fl As File
    
27.     Dim sfd As Folder
    
28.    
    
29.     For Each fl In fd.Files '通过循环把文件逐个放在数组内
    
30.         If Right(fl.Name, 3) = "xls" Or Right(fl.Name, 4) = "xlsx" Then
    
31.             cntFiles = cntFiles + 1
    
32.             ArrFiles(cntFiles) = fl.Path
    
33.         End If
    
34.     Next fl
    
35.    
    
36.     If fd.SubFolders.Count = 0 Then Exit Sub 'SubFolders返回由指定文件夹中所有子文件夹（包括隐藏文件夹和系统文件夹）组成的 Folders 集合
    
37.     For Each sfd In fd.SubFolders '在 Folders 集合进行循环查找
    
38.         SearchFiles sfd '使用递归方法查找下一个文件夹
    
39.     Next
    
40. 
    
41. End Sub

复制代码

高飞扬

这位老师，具体怎么执行能用附件形式体现一下吗？ 我将代码导入不能直接运行啊……

lsdongjh

高飞扬 发表于 2014-10-17 13:05
这位老师，具体怎么执行能用附件形式体现一下吗？ 我将代码导入不能直接运行啊……

忘了一个核心问题，要使用FileSystemObject对象，首先引用microsoft scripting runtime，具体方法:VBE--工具--引用--找到microsoft scripting runtime项目并选中

高飞扬

是可以运行了，但是只是将文件列举到A列了，并没有将相关文件中的VB和宏删除啊？

高飞扬

没有下文么？

高飞扬

求老师指点解决后面的问题，就是如何能够将列到A列里面路径的每一个文件中的宏删除呢？

lsdongjh

高飞扬 发表于 2014-10-21 10:57
求老师指点解决后面的问题，就是如何能够将列到A列里面路径的每一个文件中的宏删除呢？

红色部分改成你的删除代码就成啊   
For i = LBound(ArrFiles) To UBound(ArrFiles)
        If ArrFiles(i) = "" Then Exit For
       Debug.Print i & ">>>" & ArrFiles(i)
    Next
   
   

高飞扬

lsdongjh 发表于 2014-10-21 11:33
红色部分改成你的删除代码就成啊   
For i = LBound(ArrFiles) To UBound(ArrFiles)
        If ArrFi ...

老师能贴个附件或者完整一点吗？还是没弄明白应该怎么加……
我一般是用这个删除，但是应该不是call BkpFilAndDel吧？
Sub BkpFilAndDel()
     ActiveWorkbook.Activate
    For i = 1 To ActiveWorkbook.VBProject.VBComponents.Count
         ActiveWorkbook.VBProject.VBComponents(i).CodeModule.DeleteLines 1, ActiveWorkbook.VBProject.VBComponents(i).CodeModule.CountOfLines
     Next
End Sub