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]

The code at Create hyperlink automatically from cell text value to corresponding file name on server should fit your requirements with a few changes, e.g. loop through all the sheets, look in column C cells and extract the last part of the cell value for the file name.

 

[Ali M]

Hi John
I 'm not sure if I can modify your code . it's really difficult for me , but will show user defined type not defined when I test your code for this
Private Sub Get_Files_In_Folder(folderPath As String, filesArrayList As mscorlib.ArrayList)

 

[John_w]

but will show user defined type not defined when I test your code for this
Private Sub Get_Files_In_Folder(folderPath As String, filesArrayList As mscorlib.ArrayList)

As stated in my post on the other thread, you must set a reference to mscorlib.dll, otherwise you'll get that error. Do this via Tools -> References in the VBA editor and tick mscorlib.dll in the list of Available References. If it isn't listed, click the Browse... button and find mscorlib.tlb in a subfolder of C:\Windows\Microsoft.NET\Framework\. On my machine mscorlib.tlb is in the \v4.0.30319\ subfolder, so the full path is C:\Windows\Microsoft.NET\Framework\v4.0.30319\mscorlib.tlb.

Note that the early binding reference to mscorlib.dll is needed because of the Implements mscorlib.IComparer line in the clsFileComparer class module. Without that class module the reference isn't needed and we could do this in the main procedure:

    Dim filesArrayList As Object
    Set filesArrayList = CreateObject("System.Collections.ArrayList")

instead of:

    Dim filesArrayList As mscorlib.ArrayList
    Set filesArrayList = New mscorlib.ArrayList

However, clsFileComparer is needed for the binary search of the ArrayList.

Here is the code modified for your situation.

Standard module

'References required
'mscorlib.dll (C:\Windows\Microsoft.NET\Framework\v4.0.30319\mscorlib.tlb)

Option Explicit

Public Sub Find_Files_Create_Hyperlinks()

    Dim mainFolder As String
    Dim ws As Worksheet
    Dim Ccell As Range
    Dim filesArrayList As mscorlib.ArrayList
    Dim fileFoundIndex As Long
    Dim file As clsFile
    Dim fileComparer As clsFileComparer
   
    mainFolder = "C:\Users\RAMDANI\Desktop\Folder\PRT\"
   
    'Get listing of all files in main folder and its subfolders and put into an ArrayList.
    'Each ArrayList item is a clsFile object which has separate properties for the file name and folder path, so that just the file name part can be searched
   
    Set filesArrayList = New mscorlib.ArrayList
    Get_Files_In_Folder mainFolder, filesArrayList
       
    'Sort the ArrayList in ascending order of file name, for fast searching using BinarySearch_3 method below

    Set fileComparer = New clsFileComparer
    filesArrayList.Sort_2 fileComparer

    '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))
       
            'Put last part of this cell's value (the file name being sought) in a clsFile structure and search for it in filesArrayList using BinarySearch
           
            Set file = New clsFile
            file.fileName = Mid(Ccell.Value, InStrRev(Ccell.Value, " ") + 1) & ".pdf"
            file.folderPath = ""
            Ccell.Hyperlinks.Delete
           
            fileFoundIndex = filesArrayList.BinarySearch_3(file, fileComparer)
           
            If fileFoundIndex >= 0 Then
                Set file = filesArrayList(fileFoundIndex)
                Ccell.Worksheet.Hyperlinks.Add Anchor:=Ccell, Address:=file.folderPath & file.fileName, 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 Sub Get_Files_In_Folder(folderPath As String, filesArrayList As mscorlib.ArrayList)

    Dim WSh As Object   'WshShell
    Dim command As String
    Dim files As Variant
    Dim file As clsFile
    Dim i As Long, p As Long
   
    Set WSh = CreateObject("WScript.Shell") 'New WshShell

    'Get list of all files in specified folder and its subfolders
   
    command = "cmd /c DIR /S /B " & Chr(34) & folderPath & Chr(34)
    files = Split(WSh.Exec(command).StdOut.ReadAll, vbCrLf)
   
    'Put the files in an ArrayList.  Each file item is a clsFile object
   
    For i = 0 To UBound(files) - 1
        p = InStrRev(files(i), "\")
        Set file = New clsFile
        file.fileName = Mid(files(i), p + 1)
        file.folderPath = Left(files(i), p)
        filesArrayList.Add file
    Next
   
End Sub

Class module, renamed as clsFile

Option Explicit

Public fileName As String
Public folderPath As String

Class module, renamed as clsFileComparer

Option Explicit

Implements mscorlib.IComparer

'Compare the fileName string property of two clsFile objects
'Returns:
'   -1      file1.fileName is less than file2.fileName
'   0       file1.fileName is equal to file2.fileName
'   1       file1.fileName is greater than file2.fileName

Private Function IComparer_Compare(ByVal file1 As Variant, ByVal file2 As Variant) As Long
    'Debug.Print file1.fileName, file2.fileName
    IComparer_Compare = StrComp(file1.fileName, file2.fileName, vbTextCompare)
End Function

Private Sub IComparer_TypeCheck(ByVal CurrentVarType As VbVarType, Example As Variant)
    'This second interface callback routine is not used
End Sub

 

[Ali M]

s stated in my post on the other thread, you must set a reference to mscorlib.dll, otherwise you'll get that error

sorry I don't read well
gives automation error in this line

Set filesArrayList = CreateObject("System.Collections.ArrayList")

 

[John_w]

gives automation error in this line

Set filesArrayList = CreateObject("System.Collections.ArrayList")

No, don't use that. I only posted that to explain why you need to set the reference and that

    Dim filesArrayList As mscorlib.ArrayList
    Set filesArrayList = New mscorlib.ArrayList

is needed, as shown in the main procedure.

 

[Ali M]

the same error in this line

 Set filesArrayList = New mscorlib.ArrayList

 

[John_w]

Have you set the reference to mscorlib.dll?

 

[Ali M]

yes and I made sure again . I see it to be selected.

 

[John_w]

Is it ticked? Like this:

Note - I browsed to and selected C:\Windows\Microsoft.NET\Framework\v4.0.30319\mscorlib.tlb and VBA automatically changed the location to C:\Windows\Microsoft.NET\Framework64\v4.0.30319\mscorlib.tlb (I'm using 64-bit Excel).