目录共有n个文件，需要删除文件n1个文件，目录保留文件n2

ning84

1. Sub del1()
   
2.    Dim Fso As FileSystemObject
   
3.    Dim oFile As File
   
4.    Dim oFolder As Folder
   
5.    Dim Str, oRow As Integer
   
6.    Dim Sht As Worksheet
   
7.    Dim Rng As Range, oRng As Range
   
8.        Set Sht = Sheet3
   
9.        Set Rng = Sht.Cells(5, 1).CurrentRegion
   
10.        ''
    
11.        Str = ""
    
12.            For ii = 1 To Rng.Rows.Count
    
13.               Str = Str & Rng(ii, "D") & ","
    
14.            Next ii
    
15.        Debug.Print Str
    
16.       
    
17.        ''Debug.Print Rng.Address
    
18.        Set Fso = New FileSystemObject
    
19.        Set oFolder = Fso.GetFolder(ThisWorkbook.Path)
    
20.        Debug.Print oFolder.Name
    
21.        oRow = Rng.Row + Rng.Rows.Count + 10
    
22.        For Each oFile In oFolder.Files
    
23.            If InStr(Str, oFile.Path) = 0 And InStr(oFile.Name, "l.xlsm") = 0 Then
    
24.                'Debug.Print oFile.Path
    
25.                'oFile.Delete True
    
26.                Sht.Cells(oRow, "A") = oFile.Name
    
27.                Sht.Cells(oRow, "D") = oFile.Path
    
28.                oRow = oRow + 1
    
29.            End If
    
30.        Next oFile
    
31.        Set oRng = Sht.Cells(oRow - 2, "A").CurrentRegion
    
32.        Debug.Print oRng.Address, oRng.Row, oRng.Rows.Count
    
33.        Stop
    
34.        oRng.EntireRow.Select
    
35.        Sht.Cells(oRng.Row - 2, "A") = oFolder.Name & "目录共有" & oFolder.Files.Count & "个文件，需要删除文件" & oRng.Rows.Count _
    
36.               & oFolder.Name & "目录保留文件:" & Rng.Rows.Count
    
37.       
    
38.        Stop
    
39.        For ii = 1 To oRng.Rows.Count
    
40.            Set oFile = Fso.GetFile(oRng(ii, 4))
    
41.            Debug.Print oFile.Name, oFile.Path
    
42.            oFile.Delete True
    
43.        Next ii
    
44.        Stop
    
45.        oRng.Clear
    
46.       
    
47. End Sub
    
48. 
    

复制代码

今铭昔

ning84

今铭昔 发表于 2023-7-15 06:33

有点高深，需要花时间继续学习。

ykcbf1100

附件供参考。。。