总和为零时如何删除pdf文件

debugcn 发表于 Dev

布兰登

我正在尝试查看当行平衡为零时是否有删除pdf文件的方法。我尝试遵循此方法，但无法为我工作，任何对我指明正确方向的帮助将不胜感激。

目标

如果第N5列平衡为零（如果存在），则删除pdf文件，pdf通常以A5中的RGN命名
遍历所有行，直到到达末尾
奖励是考虑通配符命名，因为有时pdf可能是RGN_649610.pdf

如图所示，当N5平衡为0时，应删除示例649610.pdf。

C:.
│   TES_123.xlsx
│
└───Scanned
    ├───DIR1
    │       649610.pdf
    │       649615.pdf
    │
    └───DIR2
            649612.pdf
            649617.pdf

Excel图片

我试过的代码

Sub delete_INACTIVE_files()
Const path = "C:\Users\bmh\Desktop\TES 123\"
Dim r As Range
Set r = Cells(5, 14)
Do Until r = ""
    If UCase(r.Value) = "0" Then
        If Dir(path & "Scanned" & "\DIR1" & "\" & r.Offset(0, -13) & ".pdf") <> "" Then
            Kill path & "Scanned" & "\DIR1" & "\" & r.Offset(0, -13) & ".pdf"
        End If
    End If
    Set r = r.Offset(5, 0)
Loop
End Sub

蒂姆·威廉姆斯

尝试这个：

Sub delete_INACTIVE_files()
    Const PATH = "C:\Users\bmh\Desktop\TES 123\Scanned\"
    Dim r As Range, ws As Worksheet, id, n, f, files As Collection, fName
    
    Set files = GetMatches(PATH, "*.pdf") 'find all files in the folder/subfolders
    Set ws = ActiveSheet
    Set r = ws.Cells(5, 14)
    Do While Len(r.Value) > 0
        If r.Value = 0 Then
            id = ws.Cells(r.Row, "A").Value 'get the Region
            'find any matching files and delete them
            For n = files.Count To 1 Step -1
                Set f = files(n)
                fName = UCase(f.Name)
                If fName = id & ".PDF" Or _
                   fName = "RGN_" & id & ".PDF" Then
                    f.Delete        'delete the file
                    files.Remove n  'remove from the collection
                End If
            Next n
        End If
        Set r = r.Offset(1, 0) 'next row
    Loop
End Sub

'Return a collection of file objects given a starting folder and a file pattern
'  e.g. "*.txt"
'Pass False for last parameter if don't want to check subfolders
Function GetMatches(startFolder As String, filePattern As String, _
                    Optional subFolders As Boolean = True) As Collection

    Dim fso, fldr, f, subFldr
    Dim colFiles As New Collection
    Dim colSub As New Collection
    
    Set fso = CreateObject("scripting.filesystemobject")
    colSub.Add startFolder
    Do While colSub.Count > 0
        Set fldr = fso.getfolder(colSub(1))
        colSub.Remove 1
        For Each f In fldr.files
            If UCase(f.Name) Like UCase(filePattern) Then colFiles.Add f
        Next f
        If subFolders Then
            For Each subFldr In fldr.subFolders
                colSub.Add subFldr.PATH
            Next subFldr
        End If
    Loop
    Set GetMatches = colFiles
End Function

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。