[已解决]批量删除同文件夹中的所有文件里的代码？

小雨饰品

请教：用VBA批量删除同文件夹中的所有文件里的代码？
或者批量删除同文件夹中的所有文件内的"thisWorkbook"中的代码？
谢谢！！！

最佳答案

月排行榜 / 总排行榜

zjdh

2012-7-2 19:17

1. Sub 删除宏()  '2003可用
   
2.     Application.ScreenUpdating = False
   
3.     Application.EnableEvents = False
   
4.     Application.DisplayAlerts = False
   
5.     On Error Resume Next
   
6.     Set Myf = CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件目录：", &H1)
   
7.     If Not Myf Is Nothing Then
   
8.         Directory = Myf.self.Path
   
9.     End If
   
10.     MyName = Dir(Directory & "\*.xls")
    
11.     Do While MyName <> ""
    
12.         Workbooks.Open (Directory & "" & MyName)
    
13.         With ActiveWorkbook
    
14.         '**删除各模块内容及窗体
    
15.             For Each m In .VBProject.VBComponents
    
16.                 If m.Type = 100 Then
    
17.                     m.CodeModule.DeleteLines 1, m.CodeModule.CountOfLines
    
18.                 Else
    
19.                     .VBProject.VBComponents.Remove m
    
20.                 End If
    
21.             Next
    
22.         '*****************
    
23.         .Close True
    
24.         End With
    
25.         MyName = Dir
    
26.     Loop
    
27.     Application.EnableEvents = True
    
28.     Application.DisplayAlerts = True
    
29.     Application.ScreenUpdating = True
    
30. End Sub

复制代码

跳转到最佳答案楼层

无聊的疯子

代码还要打开工作薄后才能删除,既然是要删除所有的文件了,还不如选择中文件夹按 Ctrl + D 然后再按个 Y
其速度和效率都比代码强

小雨饰品

谢谢，我只想删除文件里面的代码，不想删除文件。

无聊的疯子

小雨饰品 发表于 2012-7-2 14:21
谢谢，我只想删除文件里面的代码，不想删除文件。

这个问题,给人的感觉有点像是要搞坏事情一样呢!!!

{:101:}{:101:}{:101:}{:101:}

zjdh

1. Sub 删除宏()  '2003可用
   
2.     Application.ScreenUpdating = False
   
3.     Application.EnableEvents = False
   
4.     Application.DisplayAlerts = False
   
5.     On Error Resume Next
   
6.     Set Myf = CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件目录：", &H1)
   
7.     If Not Myf Is Nothing Then
   
8.         Directory = Myf.self.Path
   
9.     End If
   
10.     MyName = Dir(Directory & "\*.xls")
    
11.     Do While MyName <> ""
    
12.         Workbooks.Open (Directory & "" & MyName)
    
13.         With ActiveWorkbook
    
14.         '**删除各模块内容及窗体
    
15.             For Each m In .VBProject.VBComponents
    
16.                 If m.Type = 100 Then
    
17.                     m.CodeModule.DeleteLines 1, m.CodeModule.CountOfLines
    
18.                 Else
    
19.                     .VBProject.VBComponents.Remove m
    
20.                 End If
    
21.             Next
    
22.         '*****************
    
23.         .Close True
    
24.         End With
    
25.         MyName = Dir
    
26.     Loop
    
27.     Application.EnableEvents = True
    
28.     Application.DisplayAlerts = True
    
29.     Application.ScreenUpdating = True
    
30. End Sub

复制代码

小雨饰品

zjdh 发表于 2012-7-2 19:17

谢谢，完全达到效果。

小雨饰品

zjdh 发表于 2012-7-2 19:17

谢谢，完全达到效果。