-1

We have a series of Excel workbooks that keep a running total of past transactions for each year. These workbooks each log past transactions, one per row, across 12 worksheets, one for each month. 5-digit numbered tickets with transaction data are scanned daily and saved as .jpg files on our server, and at the end of each row in each workbook is a hyperlink that opens the saved .jpg corresponding to the logged transaction in that particular row.

Each link contains a formula that, along with VBA code that I was able to find, placed in Module1 of the workbook, determines whether or not the .jpg file being referenced actually exists on the server; if the file does exist, the link to the ticket file is displayed as normal, but if it does not exist, "MISSING" is displayed in place of the link. This is the VBA code in Module1:

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

This all works fine, but I would now like to update the ticket link formula to determine if a ticket has been scanned and saved on the server as a .jpg file but is placed in the wrong subfolder. Essentially, what I need is VBA code that would determine if a dynamic (in that it will differ for each line) filename specified in the workbook exists anywhere within any subfolder of the file path on the server for a specific year, and if so, return either "true" if it does, or "false" if it does not. However, I am not experienced enough with VBA to know how to do this myself. If anyone could come up with anything I could use to accomplish this, it would be greatly appreciated. Thanks.

braX
  • 11,506
  • 5
  • 20
  • 33
GDD
  • 1
  • There are plenty of existing posts here on SO which cover how to search subfolders for files - for example: https://stackoverflow.com/questions/43284289/convert-rtf-to-docx-from-selected-folder-and-its-subfolders-in-vba/43286419#43286419 It might be better to run this in "batch" mode - ie. find all files matching *.jpg and then search that returned set of file names for your missing files. If you ran this per-line using a user-defined formula it would be relatively slow, since you'd be searching the whole collection once for every missing row. – Tim Williams Oct 29 '19 at 21:26
  • @Tim - Thanks for the feedback. Yes, I definitely want to avoid it being slow if possible, especially since there's already a slight slowdown with the formulas/code that I have there currently. If I was going to run something in batch mode, how would I go about doing that? From what I understand, for what I have running right now, the VBA is placed in Module1, and then it's utilized like a regular Excel function within the formula on each line, but what it sounds like you're talking about is essentially doing the opposite. I apologize in advance, I'm just really flying blind here. – GDD Oct 30 '19 at 18:52
  • How many total files do you have, are they all named xxxxx.jpg (5 digits plus ".jpg") and are the file names unique? – Tim Williams Oct 30 '19 at 19:02
  • For this year, there are currently 3,663 total files, however, as more files are created each day, the number of total files will never stay the same for very long (along with this year, I'd also want to use this in the workbook for each upcoming year). Yes, each file is named with 5 digits and as a .jpg. The files are organized by year, then month, then day, ex - "A:\Pictures\Document Pictures\Tickets\2019\January 2019\January 2, 2019\xxxxx.jpg". As such, files will always be uniquely named within each day, but within the year as a whole, it's possible there could be files with the same name. – GDD Oct 30 '19 at 19:30

2 Answers2

0

As there is no too much detail regarding your DataSheet structure, try this one:

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

This code will search for a file (File as string), on a Sourcepath (mySourcePath as string) including or not subfolders (IncludeSubfolders as boolean). You should include a condition like (example) If myFile.Name = File Then IncludeSubFolders = False, Exit For in order to leave the loop.

I created that one as a procedure, so it is not returning anything, just adjust to your need or make it function.

Hope it helps!

David García Bodego
  • 1,058
  • 3
  • 13
  • 21
  • Thanks for the feedback. I apologize, but I don't know enough to be able to successfully adjust anything in the code; I know next to nothing about VBA except for how to record macros in Excel and then possibly slightly modify the resulting VBA to try to accomplish what I need. I can usually combine functions to create formulas in Excel without a problem, but to me, that's far more straightforward than VBA, where I don't even know where to begin. If it would help, I could provide more information about whatever you need if it would help communicate what I'm trying to do more clearly. – GDD Oct 30 '19 at 18:39
0

Here's one approach - you will need to adjust for where your data is located etc.

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
Tim Williams
  • 154,628
  • 8
  • 97
  • 125