如何批量删除文件夹（含子文件夹）下各工作簿中除指定工作表外的所有工作表？

lss001 · 发表于 2017-4-10 18:53

本帖最后由 lss001 于 2017-4-10 20:29 编辑

Sub Dos() '调用Dos搜索文件
　　Dim sht As Object
Set myFolder = CreateObject("Shell.Application").BrowseForFolder(1, "GetFolder", 0)
myPath = ThisWorkbook.Path & "\"
With CreateObject("Wscript.Shell")
      ar = Split(.exec("cmd /c dir/b /s " & Chr(34) & myPath & Chr(34)).StdOut.ReadAll, vbCrLf)
      ar = Filter(ar, ".xl", True) '指定搜索文件类型,True包含,False不包含
For i = 0 To UBound(ar)
      If ar(i) <> ThisWorkbook.FullName And ar(i) <> "" Then  '排除当前文件与空文件
         Workbooks.Open Filename:=ar(i) '打开找到文件
　　       Application.DisplayAlerts = False
　　       For Each sht In ThisWorkbook.Worksheets
　　          If sht.Name <> "25.教师年人均发表教学研究论文情况" Then
　　          sht.Delete
　　          End If
　　       Next
　　       Application.DisplayAlerts = True
         ActiveWorkbook.Close Savechanges:=True '处理后自动保存文件
      End If
Next
End With
End Sub
重要提示运行代码前先备份文件！！！

jiminyanyan · 发表于 2017-4-10 21:33

Dos搜索文件挺强大．．．．．

小花鹿 · 发表于 2017-4-10 21:42

dengxsh 发表于 2017-4-6 11:55
谢谢您的指导，估计够我看一阵子的，可眼下大量的手工劳动折磨死我了……恳请支援啊！

学点VBA有时候可以很大的提高工作效率.............................................................................

dengxsh · 发表于 2017-4-11 07:57

小花鹿发表于 2017-4-10 21:42
学点VBA有时候可以很大的提高工作效率............................................................... ...

是啊，正在努力着！

宋晓晓 · 发表于 2021-9-6 16:09

lss001 发表于 2017-4-10 18:53
Sub Dos() '调用Dos搜索文件
　　Dim sht As Object
Set myFolder = CreateObject("Shell.Applicati ...

大佬666，受教了。

chenshiyyb · 发表于 2023-4-20 18:05

[img][/img]

chenshiyyb · 发表于 2023-4-20 18:07

不好意思，我也有同样的问题，运行后发现提示1004错误，请问如何解决

chenshiyyb · 发表于 2023-4-20 18:13

chenshiyyb · 发表于 2023-4-22 14:58

请高手指点

		自动登录	找回密码
密码			免费注册