macro to match part of PDF file name in cell with folders & subfolders to open it

[Ali M]

Hi guys
I search for macro to match part of file name in cells for column C across sheets with file names in folders & subfolders
the PDF files names will be like this in column C for each sheet
REFERENCE OPERATION NUMBER TK_12346757
DEL PROCESS REF HJ123345
CHECK VERSUS GT-1234556

the PDF files names will be TK_12346757,HJ123345,GT-1234556 in folders & subfolders .
so when match the part of PDF file name in column C for each sheet with file name in folders & subfolders should be based on the last item because the last item is matched . then should hyperlink the cells in column C for each sheet and open it when click cell , if the last item is not matched when match the part of PDF file name in column C for each sheet with file name in folders & subfolders should pops message "the file is not found ".
the files will be in folders & subfolders like this
C:\Users\RAMDANI\Desktop\Folder\PRT
C:\Users\RAMDANI\Desktop\Folder\PRT\output\
C:\Users\RAMDANI\Desktop\Folder\PRT\output\operation\
thanks in advance

 

[John_w]

You haven't answered my two questions.

and there files names contains three or four parts as maximum for each file name , will contain space after each part except last part as I posted in OP and last post .

But how does the code know how many parts it should read from the cell?

In your OP you said it was 1 part - the last part.

Now you say it is 3 or 4 parts. But I guess 2 parts is also possible, given your SN MM2000 example.

How does the code determine whether it should read 1, 2, 3 or 4 parts from the cell?

 

[Ali M]

really sorry John about this confusion !
so you mean the EXCEL can't specify the last part if there are multiple parts for the whole file name?
I mean if the file name in cell contains four parts & file name in folder and subfolder contains one part
like this REF DEL SN MM2000 in C2, and in folder could be MM2000 , so can't match MM2000 ?

 

[John_w]

so you mean the EXCEL can't specify the last part if there are multiple parts for the whole file name?
I mean if the file name in cell contains four parts & file name in folder and subfolder contains one part
like this REF DEL SN MM2000 in C2, and in folder could be MM2000 , so can't match MM2000 ?

It's not a case of Excel can't 'do it', but looking for a consistent 'pattern' or 'rule' in the data which can be programmed.

All the previous macros were looking at just the last part of the cell value, based on your OP examples.

So given your new examples, the following macro looks at from 1 part up to 4 last parts of the cell value, until a matching file name is found. For example, if C2 contains REF DEL SN MM2000, the macro looks for MM2000.pdf; if not found it looks for SN MM2000.pdf; if not found it looks for DEL SN MM2000.pdf; if not found it looks for REF DEL SN MM2000.pdf; if not found it displays the 'File not found' message. If the cell contains only 1 part it looks for just that 1 part. If the cell contains 5 or more parts it looks for 1 to 4 of the last parts.

Public Sub Find_Files_Create_Hyperlinks()

    Dim mainFolder As String
    Dim ws As Worksheet
    Dim Ccell As Range
    Dim filesColl As Collection
    Dim parts() As String
    Dim i As Long
    Dim foundFilePath As String
    Dim findFileName As String
    Dim filePath As Variant
    
    mainFolder = "C:\Users\RAMDANI\Desktop\Folder\PRT\"
    
    'Create collection of file paths in mainFolder and its subfolders
    
    Set filesColl = New Collection
    GetFiles mainFolder, filesColl
        
    'Loop all sheets

    For Each ws In ThisWorkbook.Worksheets
        
        'Loop column C cells starting at C2
        
        For Each Ccell In ws.Range("C2", ws.Cells(ws.Rows.Count, "C").End(xlUp))
        
            Ccell.Hyperlinks.Delete
            
            'Look for 1, 2, 3 and 4 parts of this cell's value, starting from last part, in collection of file paths, until a .pdf file name match is found
                       
            parts = Split(Ccell.Value, " ")
            foundFilePath = ""
            i = UBound(parts) 'start at last part of cell value
            While i > Application.WorksheetFunction.Max(0, UBound(parts) - 3) And foundFilePath = ""
                findFileName = JoinArrayParts(parts, i, UBound(parts)) & ".pdf"
                For Each filePath In filesColl
                    If StrComp(Mid(filePath, InStrRev(filePath, "\") + 1), findFileName, vbTextCompare) = 0 Then
                        foundFilePath = filePath
                        Exit For
                    End If
                Next
                i = i - 1
            Wend
            
            If foundFilePath <> "" Then
                ws.Range("L1").Value = foundFilePath
                Ccell.Worksheet.Hyperlinks.Add Anchor:=Ccell, Address:=foundFilePath, TextToDisplay:=Ccell.Value
            Else
                'File not found
                If MsgBox("File not found." & vbCrLf & vbCrLf & _
                       "Sheet: " & ws.Name & ", cell: " & Ccell.Address(False, False) & vbCrLf & _
                       "File: " & Mid(Ccell.Value, InStrRev(Ccell.Value, " ") + 1) & ".pdf" & vbCrLf & vbCrLf & _
                       "Click OK to continue or Cancel to quit.", vbExclamation + vbOKCancel) = vbCancel Then Exit Sub
            End If
            
        Next
        
    Next
       
End Sub


Private Function JoinArrayParts(arr() As String, iStart As Long, iEnd As Long) As String
    Dim i As Long
    JoinArrayParts = ""
    For i = iStart To iEnd
        JoinArrayParts = " " & JoinArrayParts & arr(i)
    Next
    JoinArrayParts = Mid(JoinArrayParts, 2)
End Function


Private Sub GetFiles(folderPath As String, filesColl As Collection)

    Static FSO As Object
    Dim FSfolder As Object
    Dim FSsubfolder As Object
    Dim FSfile As Object
    
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
    
    'Get files in this folder
    Set FSfolder = FSO.GetFolder(folderPath)
    For Each FSfile In FSfolder.files
        filesColl.Add FSfile.Path, FSfile.Path
    Next
    
    'Get files in subfolders
    For Each FSsubfolder In FSfolder.SubFolders
        GetFiles FSsubfolder.Path, filesColl
    Next
    
End Sub

 

[Ali M]

So given your new examples, the following macro looks at from 1 part up to 4 last parts of the cell value, until a matching file name is found. For example, if C2 contains REF DEL SN MM2000, the macro looks for MM2000.pdf; if not found it looks for SN MM2000.pdf; if not found it looks for DEL SN MM2000.pdf; if not found it looks for REF DEL SN MM2000.pdf; if not found it displays the 'File not found' message. If the cell contains only 1 part it looks for just that 1 part. If the cell contains 5 or more parts it looks for 1 to 4 of the last parts.

I'm not sure if theses conditions could be , because I tested for the file name in cell REF DEL SN MM2000
and the file in folder SN MM2000.pdf then will pop message the file is not found, but if the file name is MM2000 then will hyperlink & open the file . so what's the problem?

 

[John_w]

because I tested for the file name in cell REF DEL SN MM2000
and the file in folder SN MM2000.pdf then will pop message the file is not found, but if the file name is MM2000 then will hyperlink & open the file . so what's the problem?

Sorry, there's a bug in the JoinArrayParts function. Not sure how I missed that . Replace it with:

Private Function JoinArrayParts(arr() As String, iStart As Long, iEnd As Long) As String
    Dim i As Long
    JoinArrayParts = ""
    For i = iStart To iEnd
        JoinArrayParts = JoinArrayParts & arr(i) & " "
    Next
    JoinArrayParts = Left(JoinArrayParts, Len(JoinArrayParts) - 1)
End Function

Also, the MsgBox text for file not found is not appropriate because the latest code is looking for multiple matching file names, not just one. Therefore change it to:

                If MsgBox("Matching file not found." & vbCrLf & vbCrLf & _
                       "Sheet: " & ws.Name & ", cell: " & Ccell.Address(False, False) & vbCrLf & _
                       "Value: " & Ccell.Value & vbCrLf & vbCrLf & _
                       "Click OK to continue or Cancel to quit.", vbExclamation + vbOKCancel) = vbCancel Then Exit Sub

 

[Ali M]

thanks for your efforts .
I wrote some random items but I'm not sure what's wrong for some items don't allow hyperlink despite of I'm pretty sure is the same name and I use copy & paste into cells to avoid spaces instead write manually !

 

[John_w]

Hopefully this is the final fix.

Change:

            While i > Application.WorksheetFunction.Max(0, UBound(parts) - 3) And foundFilePath = ""

to:

            While i >= Application.WorksheetFunction.Max(0, UBound(parts) - 3) And foundFilePath = ""

 

[Ali M]

Hopefully this is the final fix.

yes seem to work without problem.
much appreciated for your time & assistance .