Hsieh

¦^´_ 1# PJChen
°Ñ¦Ò¥Îµ{¦¡¼gµ{¦¡ (VBProject / VBComponents)

1. Sub Try()
   
2. fd = ThisWorkbook.Path & "\" & Sheets(1).[E6] & "\"
   
3. fs = Dir(fd & "*.xlsm")
   
4. Do Until fs = ""
   
5. With Workbooks.Open(fd & fs)
   
6. For Each vbc In .VBProject.VBComponents
   
7.   Select Case vbc.Type
   
8.   Case vbext_rk_Project, vbext_wt_Browser, vbext_ct_MSForm 'µù
   
9.     .VBProject.VBComponents.Remove .Item(vbc.Name)
   
10. 
    
11.   Case Else
    
12.     .VBProject.VBComponents(vbc.Name).CodeModule.DeleteLines 1, _
    
13.     .VBProject.VBComponents(vbc.Name).CodeModule.CountOfLines
    
14. 
    
15.   End Select
    
16. Next
    
17. .Close 1
    
18. End With
    
19. fs = Dir
    
20. Loop
    
21. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 5# PJChen


    ¶}±ÒÀɮפ£§ó·s³sµ²

1. Sub Try()
   
2. fd = ThisWorkbook.Path & "\" & Sheets(1).[E6] & "\"
   
3. fs = Dir(fd & "*.xlsm")
   
4. fs = Dir(fd & "*.xls")
   
5. Do Until fs = ""
   
6. Application.DisplayAlerts = False
   
7. With Workbooks.Open(fd & fs, False)  ' ¶}±ÒÀɮפ£§ó·s³sµ²
   
8. 'With Workbooks.Open(fd & fs, True)  ' ¶}±ÒÀɮקó·s³sµ²
   
9. 
   
10. For Each vbc In .VBProject.VBComponents
    
11.   Select Case vbc.Type
    
12.   Case vbext_rk_Project, vbext_wt_Browser, vbext_ct_MSForm 'µù
    
13.     .VBProject.VBComponents.Remove .Item(vbc.Name)
    
14. 
    
15.   Case Else
    
16.     .VBProject.VBComponents(vbc.Name).CodeModule.DeleteLines 1, _
    
17.     .VBProject.VBComponents(vbc.Name).CodeModule.CountOfLines
    
18. 
    
19.   End Select
    
20. Next
    
21. .Close 1
    
22. End With
    
23. fs = Dir
    
24. Loop
    
25. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 8# PJChen
1. ¨ÃµL§A©Ò»¡·íµLµ{¦¡½XÀÉ®×°õ¦æ®É·|°±¤îªº²{¶H
2. ­n¥¿½TÅã¥ÜÀɦW¡A¥u¯à­É¥ÎÀx¦s®æÅã¥Ü

1. Sub Try()
   
2. Dim fs
   
3. Application.DisplayAlerts = False
   
4. fd = ThisWorkbook.Path & "\" & Sheets(1).[E6] 'Àɮץؿý
   
5. Set fos = CreateObject("Scripting.FileSystemObject")
   
6. Set fdn = fos.getfolder(fd)
   
7. Set fc = fdn.Files 'Àɮץؿý¤¤©Ò¦³ÀÉ®×
   
8. For Each fs In fc
   
9. [A1] = fs.Name '­É¥ÎÀx¦s®æÅã¥Ü¥¿½TÀɦW
   
10. With Workbooks.Open(fd & "\" & [A1].Text, 0) ' ¶}±ÒÀɮפ£§ó·s³sµ²
    
11. For Each vbc In .VBProject.VBComponents
    
12.   Select Case vbc.Type
    
13.   Case 100
    
14.     .VBProject.VBComponents(vbc.Name).CodeModule.DeleteLines 1, _
    
15.     .VBProject.VBComponents(vbc.Name).CodeModule.CountOfLines '§R°£©Ò¦³µ{¦¡½X
    
16.   Case Else
    
17.     .VBProject.VBComponents.Remove .VBProject.VBComponents.Item(vbc.Name) '²¾°£¼Ò²Õ¡Bªí³æ¡BÃþ§O¼Ò²Õ
    
18.   End Select
    
19. Next
    
20. .Close 1
    
21. End With
    
22. Next
    
23. End Sub

½Æ»s¥N½X