Question

我在VBA中寻找一种干净的方法来解决这个问题：

我有一张包含1行值的Excel表格。如果在指定目录中找到值，则应保留它们并删除所有其他值。

一个简短的例子：

表：

C：\ Temp \ 1000.pdf上的目录内容; 1200.pdf; 1800.pdf; 0001.pdf

所以行动应该保持1000.pdf和1800.pdf并删除所有其他* .pdf＆＃39>

这是我尝试过的，但这只是一个单元格。

Dim cName As String

cName = Sheets("Blad2").Range("A2").Text

If Len(Dir("C:\Temp\" & cName, vbDirectory)) = 0 Then
Kill "C:\Temp\" & cName & ".pdf"
End If

Answer 1

为了提供更多的上下文，这段代码循环遍历A列中的每个单元格（保存它假设的顶部单元格是标题），并将该单元格的值提供给要检查的函数。
该函数循环遍历所提供文件夹中的每个文件（确保更新文件夹以匹配您自己的文件夹）并检查文件名是否与提供的条件相似。（有关Like操作员的更多信息，请访问：https://msdn.microsoft.com/en-us/library/swf8kaxw.aspx）

Option Explicit

Private Sub Example()
    Dim ws As Excel.Worksheet
    Dim rng As Excel.Range
    Dim cll As Excel.Range
    Dim deletedCount As Long
    Set ws = Excel.ActiveSheet
    Set rng = Excel.Intersect(ws.UsedRange.Offset(1&, 0&), ws.Columns(1), ws.UsedRange)
    For Each cll In rng.Cells
        deletedCount = deletedCount + DeleteFilesByCriteria("C:\_Test", cll.value & ".pdf", False)
    Next
    MsgBox "Deleted " & deletedCount, vbInformation
End Sub

Private Function DeleteFilesByCriteria(ByVal folderPath As String, ByVal criteria As String, Optional ByVal deleteReadOnly As Boolean = False) As Long
    'Create a reference to Microsoft Scripting Runtime
    Dim fso As Scripting.FileSystemObject
    Dim fldr As Scripting.Folder
    Dim fl As Scripting.File
    Dim deletedCount As Long
    Set fso = New Scripting.FileSystemObject
    Set fldr = fso.GetFolder(folderPath)
    For Each fl In fldr.Files
        If fl.name Like criteria Then
            fl.Delete deleteReadOnly
            deletedCount = deletedCount + 1&
        End If
    Next
    DeleteFilesByCriteria = deletedCount
End Function

Answer 2

看看这对你有帮助：

Sub RemoveFiles()
Dim sht As Worksheet
Dim range As range
Dim found As range
Dim myFolder As String
Dim currFile As String
Dim currFileNoSuffix As String

Set sht = ActiveSheet
 ' Set the range to the A column-
 '   - only visible cells (xlCellTypeVisible)
 '   - and only constants, meaning skip over empty cells 
 '     and cells containing formulas or errors (7).
Set range = sht.range("A:A").SpecialCells(xlCellTypeVisible, 7)

' the files folder
myFolder = "C:\temp\111\"

' give me the first file in the folder
currFile = Dir(myFolder)

' while the code has not gone throug all of the files in the folder
While Not currFile = vbNullString
    ' put in the variable the name of the file without its suffix,
    ' for example 11111.pdf -->  will put 11111  into the variable.
    ' ! This does not change the the actual file in the directory!
    currFileNoSuffix$ = Mid(currFile, 1, InStrRev(currFile, ".") - 1)

    ' look for the name of the file in the "A" column.
    ' xlWhole means to search for an exact match, for example
    ' if you have a file named 111.pdf, it will only watch with a "111" sheet entry,
    ' but not with a "1111111" entry.
    Set found = range.Find(currFileNoSuffix$, , , xlWhole, , , False)

    ' if the filename does not appear in the sheet
    If found Is Nothing Then
        ' then delete the file
        Kill myFolder & currFile
    End If

    ' give me the next file in the folder
    currFile = Dir()
Wend

End Sub

删除文件如果值不存在

2 个答案: