用vba删除子文件夹中指定文件

liuzhenhua

删除指定文件.rar (52.76 KB, 下载次数: 12)

2024-1-8 13:53 上传

点击文件名下载附件

请老师帮忙
“在这里写程序”表中做程序：
删掉子文件夹中包含“*小组.xlsx”的文件（“*小组.xls”文件不能删掉）

谢谢

wang-way

dir( 文件夹 &"*小组.xlsx")   找出来 kill

limonet

关键字：递归

3190496160

Sub Test() '
Application.ScreenUpdating = False
Dim MyName, Dic, Did, I, T, F, TT, MyFileName
T = Timer
Set Dic = CreateObject("Scripting.Dictionary")    '创建一个字典对象
Set Did = CreateObject("Scripting.Dictionary")
Set d = CreateObject("Scripting.Dictionary")
Set objShell = CreateObject("Shell.Application")
Set fs = CreateObject("Scripting.FileSystemObject")
Set objFolder = objShell.BrowseForFolder(0, "选择文件夹", 0, 0)
If objFolder Is Nothing Then MsgBox "您取消了操作！": Exit Sub
lj = objFolder.self.Path & "\"
Dic.Add (lj), ""
I = 0
Do While I < Dic.Count
    Ke = Dic.keys   '开始遍历字典
    MyName = Dir(Ke(I), vbDirectory)    '查找目录
    Do While MyName <> ""
        If MyName <> "." And MyName <> ".." Then
            If (GetAttr(Ke(I) & MyName) And vbDirectory) = vbDirectory Then    '如果是次级目录
                Dic.Add (Ke(I) & MyName & "\"), ""  '就往字典中添加这个次级目录名作为一个条目
            End If
        End If
        MyName = Dir    '继续遍历寻找
    Loop
    I = I + 1
Loop
For Each Ke In Dic.keys
    MyFileName = Dir(Ke & "*.xls*")
    Do While MyFileName <> ""
        Did.Add (Ke & MyFileName), ""
        MyFileName = Dir
    Loop
Next
For Each k In Did.keys
    If InStr(k, "小组") > 0 And InStr(k, "xlsx") > 0 Then
        Kill k
    End If
Next k
TT = Timer - T
MsgBox TT
Application.ScreenUpdating = True
End Sub

3190496160

删除指定文件.rar (38.67 KB, 下载次数: 6)

2024-1-8 14:35 上传

点击文件名下载附件

ykcbf1100

参与一下。。。

1. Sub 文件删除()   '//2024.1.8
   
2.     p = ThisWorkbook.Path & ""
   
3.     Set Fso = CreateObject("Scripting.FileSystemObject")
   
4.     Set ff = Fso.GetFolder(p)
   
5.     Call GetFiles(ff, fns, Fso)
   
6.     MsgBox "OK！"
   
7. End Sub
   
8. 
   
9. Function GetFiles(ff, fns, Fso)
   
10.     For Each f In ff.Files
    
11.         If f.Name Like "*小组.xlsx" Then
    
12.             Fso.deletefile f
    
13.         End If
    
14.     Next
    
15.     For Each fd In ff.SubFolders
    
16.         Call GetFiles(fd, fns, Fso)
    
17.     Next
    
18. End Function
    

复制代码

ykcbf1100

参与一下，附件供参考。。。

飞天篮球猪

fyi...使用Powershell命令

1. Sub RemoveFiles()
   
2. Dim oShell As Object, iCmd$
   
3. Set oShell = CreateObject("WScript.Shell")
   
4. iCmd = "Powershell -c gci " & ThisWorkbook.Path & " -file -Include '*小组.xlsx' -r | Remove-Item"
   
5. oShell.Run iCmd, , True
   
6. Set oShell = Nothing
   
7. End Sub

复制代码

飞天篮球猪

fyi...

lizhipei78

给你一个通用的，根据关键词删除相关文件
根据关键词-删除相关文件.rar (22.04 KB, 下载次数: 9)

2024-1-8 18:53 上传

点击文件名下载附件