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

lss001

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

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

小花鹿

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

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

dengxsh

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

是啊，正在努力着！

宋晓晓

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

大佬666，受教了。

chenshiyyb

[img][/img]

chenshiyyb

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

chenshiyyb

chenshiyyb

请高手指点