如何批量选择删除文件夹及子文件夹内所有EXCEL工作表中的宏代码

ykcbf1100

蒋智龙 发表于 2024-3-31 08:18
Sub RemoveMacrosFromSelectedFolder()
    Dim folderPath As String
    Dim fileName As String

你那就是AI写的，并不一定可用。
要写还是得新写。

baofa2

1. Sub Main()
   
2.   Dim strPath As String
   
3.   With Application.FileDialog(msoFileDialogFolderPicker)
   
4.     .InitialFileName = ThisWorkbook.Path
   
5.     If .Show Then strPath = .SelectedItems(1) Else Exit Sub
   
6.   End With
   
7.   If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
   
8.   'strPath = ThisWorkbook.Path
   
9.   DoApp False
   
10.   Dim i As Long, iCount As Long
    
11.   Dim objFso As Object, vrtFiles(1 To 2345) As String
    
12.   
    
13.   Set objFso = CreateObject("Scripting.FileSystemObject")
    
14.   GetFiles strPath, objFso, vrtFiles, iCount, "$", "*.xlsm"
    
15.   Set objFso = Nothing
    
16.   For i = 1 To iCount
    
17.     Workbooks.Open(vrtFiles(i), 0).SaveAs Split(vrtFiles(i), ".xls")(0), 51
    
18.     ActiveWorkbook.Close
    
19.     Kill vrtFiles(i)
    
20.   Next
    
21.   DoApp
    
22.   Beep
    
23. End Sub
    
24. 
    
25. Function GetFiles(strPath As String, objFso As Object, vrtFiles() As String, iCount As Long, strExclude As String, Optional strFilter As String = ".xls")
    
26.   Dim objSubFolder As Object, objFilterFile As Object
    
27.   For Each objFilterFile In objFso.GetFolder(strPath).Files
    
28.     If objFilterFile.Name Like strFilter Then
    
29.       If InStr(objFilterFile.Name, strExclude) = 0 Then
    
30.         iCount = iCount + 1
    
31.         vrtFiles(iCount) = objFilterFile.Path
    
32.       End If
    
33.     End If
    
34.   Next
    
35.   For Each objSubFolder In objFso.GetFolder(strPath).SubFolders
    
36.     GetFiles objSubFolder.Path, objFso, vrtFiles, iCount, strExclude, strFilter
    
37.   Next
    
38. End Function
    
39. 
    
40. Function DoApp(Optional Flag As Boolean = True)
    
41.   With Application
    
42.     .ScreenUpdating = Flag
    
43.     .DisplayAlerts = Flag
    
44.     If Flag Then .Calculation = xlCalculationAutomatic Else .Calculation = xlCalculationManual
    
45.     .EnableEvents = Flag
    
46.   End With
    
47. End Function

复制代码

蒋智龙

baofa2 发表于 2024-3-31 09:16

有错误提示

蒋智龙

baofa2 发表于 2024-3-31 09:16

运行时错误，91’:对象变量或 with 块变量未设置

baofa2

蒋智龙 发表于 2024-3-31 09:51
运行时错误，91’:对象变量或 with 块变量未设置

蒋智龙

baofa2 发表于 2024-3-31 09:55

DoApp False
  Dim i As Long, iCount As Long, wkb As Workbook
  Dim objFso As Object, vrtFiles(1 To 2345) As String
  
  Set objFso = CreateObject("Scripting.FileSystemObject")
  GetFiles strPath, objFso, vrtFiles, iCount, "$", "*.xlsm"
  Set objFso = Nothing
  For i = 1 To iCount
    Set wkb = Workbooks.Open(vrtFiles(i), 0)
    wkb.SaveAs Split(vrtFiles(i), ".xls")(0), 51
    ActiveWorkbook.Close
    Kill vrtFiles(i)
  Next
  Set wkb = Noyhing
End Sub

蒋智龙

baofa2 发表于 2024-3-31 09:55

还是一样的提示DoApp False
  Dim i As Long, iCount As Long, wkb As Workbook
  Dim objFso As Object, vrtFiles(1 To 2345) As String
  
  Set objFso = CreateObject("Scripting.FileSystemObject")
  GetFiles strPath, objFso, vrtFiles, iCount, "$", "*.xlsm"
  Set objFso = Nothing
  For i = 1 To iCount
    Set wkb = Workbooks.Open(vrtFiles(i), 0)
    wkb.SaveAs Split(vrtFiles(i), ".xls")(0), 51
    ActiveWorkbook.Close
    Kill vrtFiles(i)
  Next
  Set wkb = Noyhing
End Sub

蒋智龙

baofa2 发表于 2024-3-31 09:55

baofa2

蒋智龙 发表于 2024-3-31 10:04

选择此文件及子文件夹内所有EXCEL表并删除宏.zip (96.82 KB, 下载次数: 5)

2024-3-31 10:14 上传

点击文件名下载附件

蒋智龙

baofa2 发表于 2024-3-31 10:14

兄弟 你用的什么版本 我的是2021版office