是否可以确定特定文件是否在一系列子文件夹中的某个位置？

Question

[我们有一系列Excel工作簿，这些工作簿每年连续记录过去的交易。这些工作簿每个记录过去的事务，在12个工作表中每行记录一次，每个月记录一次。每天都会扫描带有交易数据的5位数字票证，并将其另存为.jpg文件在我们的服务器上，并且在每个工作簿的每一行的末尾都有一个超链接，用于打开与该特定行中已记录交易相对应的已保存.jpg。

每个链接都包含一个公式，以及我能够找到的VBA代码，该公式位于工作簿的Module1中，确定服务器上是否确实存在被引用的.jpg文件；如果该文件确实存在，则到票证文件的链接将按正常显示，但如果不存在，则将显示“ MISSING”代替该链接。这是Module1中的VBA代码：

Function FILEEXISTS(sPath As String)
        FILEEXISTS = Dir(sPath) <> ""
End Function

这一切都很好，但是我现在想更新票证链接公式，以确定是否已扫描票证并将其保存为.jpg文件但已放置在错误的子文件夹中。本质上，我需要的是VBA代码，该代码可以确定工作簿中指定的动态文件名（每一行各不相同）是否存在特定年份的服务器上文件路径的任何子文件夹中的任何位置，如果存在，如果是，则返回“ true”，否则返回“ false”。但是，我对VBA的经验不足，无法亲自了解如何执行此操作。如果有人能提出我可以用来完成此任务的任何东西，将不胜感激。谢谢。

Answer 1

由于您的DataSheet结构没有太多细节，请尝试以下一种方法：

Sub ListMyFiles(mySourcePath, IncludeSubfolders, File)
    Set MyObject = New Scripting.FileSystemObject
    Set mySource = MyObject.GetFolder(mySourcePath)
    On Error Resume Next
    For Each myFile In mySource.Files

         'LOOK FOR YOUR FILE WITH A CONDITION THAT EXIT THIS LOOP AND THE NEXT ONE

    Next
    If IncludeSubfolders Then
        For Each mySubFolder In mySource.SubFolders
            Call ListMyFiles(mySubFolder.path, True)
        Next
    End If
End Sub

此代码将在一个包含或不包含子文件夹（IncludeSubfolders为布尔值）的Sourcepath（mySourcePath作为字符串）上搜索文件（文件为字符串）。您应包括（例如）If myFile.Name = File Then IncludeSubFolders = False, Exit For之类的条件，以退出循环。

我创建了一个程序，所以它不返回任何东西，只是根据需要进行调整或使其起作用。

希望有帮助！

Answer 2

这里是一种方法-您将需要调整数据的位置等。

Sub UpdateFileMatches()

    Dim c As Range, dictFiles, t, msg, sht As Worksheet

    'get all jpg files, starting from the folder root
    Set dictFiles = GetMatches("A:\Pictures\Document Pictures\Tickets\", "*.jpg")
    MsgBox "Found " & dictFiles.Count & " JPG files"

    'loop over worksheets
    For Each sht In ActiveWorkbook.Worksheets
        'loop over ticket numbers in colA (or wherever)
        For Each c In sht.Range("A2:A1000").Cells
            t = c.Value
            'Is there one or more matching file found?
            If Len(t) > 0 And dictFiles.exists(t & ".jpg") Then
                msg = "Found " & dictFiles(t & ".jpg") & " file(s)"
            Else
                msg = "No match found"
            End If
            c.EntireRow.Cells(1, "J").Value = msg  '<< update the row with result
        Next c
    Next sht

End Sub

'Return a dictionary of unique file names given a starting folder and a file pattern
'  e.g. "*.jpg"
'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 Object

    Dim fso, fldr, f, subFldr, nm
    Dim dictFiles As Object
    Dim colSub As New Collection

    Set dictFiles = CreateObject("scripting.dictionary")
    Set fso = CreateObject("scripting.filesystemobject")
    colSub.Add startFolder
    filePattern = LCase(filePattern)
    Do While colSub.Count > 0
        Set fldr = fso.getfolder(colSub(1))
        colSub.Remove 1
        'check for files
        For Each f In fldr.Files
            nm = LCase(f.Name)
            If nm Like filePattern Then
                dictFiles(nm) = dictFiles(nm) + 1 'count instances
            End If
        Next f
        'check any subfolders
        If subFolders Then
            For Each subFldr In fldr.subFolders
                colSub.Add subFldr.Path
            Next subFldr
        End If
    Loop
    Set GetMatches = dictFiles
End Function