Есть ли способ определить, существует ли определенный файл где-то в ряде подпапок?

Question

У нас есть серия книг Excel, в которых хранятся итоги прошлых транзакций за каждый год. Эти рабочие книги регистрируют прошлые транзакции, по одной на строку, на 12 листах, по одному на каждый месяц. Пятизначные пронумерованные билеты с данными транзакций ежедневно сканируются и сохраняются в виде файлов .jpg на нашем сервере, а в конце каждой строки каждой рабочей книги находится гиперссылка, которая открывает сохраненный файл .jpg, соответствующий зарегистрированной транзакции в этой конкретной строке.

Каждая ссылка содержит формулу, которая наряду с кодом VBA, который мне удалось найти, помещенным в Module1 рабочей книги, определяет, существует ли на сервере файл .jpg, на который ссылаются, на самом деле;если файл существует, ссылка на файл заявки отображается как обычно, но если он не существует, вместо ссылки отображается «MISSING». Это код VBA в Module1:

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

Это все работает нормально, но теперь я хотел бы обновить формулу ссылки на билеты, чтобы определить, был ли билет отсканирован и сохранен на сервере в формате .jpg. файл, но находится в неправильной подпапке. По сути, мне нужен код VBA, который определил бы, существует ли динамическое (в том смысле, что оно будет отличаться для каждой строки) имя файла, указанное в книге, где-либо в любой подпапке пути к файлу на сервере в течение определенного года, и если да,верните либо «true», если это так, либо «false», если это не так. Тем не менее, я не достаточно опытен с VBA, чтобы знать, как сделать это самостоятельно. Если бы кто-нибудь мог придумать что-нибудь, что я мог бы использовать для достижения этой цели, это было бы очень признательно. Спасибо.

Answer 1

Вот один из подходов - вам нужно будет настроить местоположение ваших данных и т. Д.

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

Answer 2

Поскольку нет слишком подробной информации о вашей структуре 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

Этот код будет искать файл (File as string) по Sourcepath (mySourcePath как строка), включаяили не подпапки (Включить подпапки как логическое). Вы должны включить условие типа (пример) If myFile.Name = File Then IncludeSubFolders = False, Exit For, чтобы выйти из цикла.

Я создал его как процедуру, чтобы он ничего не возвращал, просто приспособился к вашей потребности или заставил его функционировать.

Надеюсь, это поможет!