VBA to find a directory based off a cell value, but not exact match

[paun_shotts]

Appreciate your help with this one please.
In my workbook on "Sheet1" In column F is where a return number is given to a return shipment.
The format of these return numbers is as follows "2307070" - 23 refers to calendar year, 07 refers to the calendar month, and 070 is the return number.
The return documents are stored in:

T:\Operations\Inventory\GRA\GRAs\GRAs - 2023

Inside this folder, are more folders for each month such as "07 - July 2023" "08 - August 2023" etc..
So now we are in folder :

T:\Operations\Inventory\GRA\GRAs\GRAs - 2023\07 - July 2023

Inside this folder, are folders for individual returns and the folders are names as "GRA2307070 - Hospital Name"
Example:

T:\Operations\Inventory\GRA\GRAs\GRAs - 2023\07 - July 2023\GRA2307070 - Hospital Name Goes Here

I have some VBA code but I cannot get it working, I want to hyperlink the cell in column F to link to the word doc (.docx) which would be in the above folders.
I will share the spreadsheet and the code and would really like someone to assist me in finding the error in my code, as it is not hyperlinking to the document.
Obviously the hospital name will change for each return, so I have inserted the "*" to try to account for variables in the folder name.
The code I have is:

Private Sub Worksheet_Change(ByVal Target As Range)



 Dim GRAPath As String
 Dim GRAFilePath As String
 Dim GRAFileName As String
  
    GRAPath = "T:\Operations\Inventory\GRA\GRAs\GRAs - 2023\07 - July 2023\"
    
    If Target.Count = 1 And Target.Column = 6 And Target.Row >= 2 Then
        If Left(Target.Value, 4) = "2307" Then
            GRAFileName = "GRA" & Target.Value
            GRAFilePath = Dir(GRAPath & GRAFileName & "*.docx")
            MsgBox GRAPath & GRAFileName & "*.docx"
            If GRAFilePath <> "" Then
                GRAFilePath = GRAPath & GRAFilePath & "\" & GRAFileName & ".docx"
                If Dir(GRAFilePath) <> "" Then
                    Target.Hyperlinks.Add Target, GRAFilePath, , , GRAFileName
                End If
            End If
        End If
    End If

End Sub

Book1
	A	B	C	D	E	F	G	H	I
1	DATE IN	TIME IN	INITIALS	COURIER USED	CON NOTE / INVOICE #	GRA#	DESCRIPTION	# OF BOXES	ATTENTION TO:
2	4/08/2023	10AM	SP	STARTRACK		2307064	3XMESH	1	DM
3	4/08/2023	10AM	SP	BUDGET		2307067	3XMESH	1	DM
4	4/08/2023	10AM	SP	STARTRACK		2307068	4XMESH	1	DM
5	4/08/2023	10AM	SP	STARTRACK		2307072	1XMESH	1	LF
6	7/08/2023	8AM	SP	STARTRACK		2307037	6XMESH	1	LF
7	7/08/2023	8AM	SP	STARTRACK		2307044	1XMESH	1	LF
Sheet1

 

[paun_shotts]

For testing purposes, I have renamed one folder, taking out the hospital name from the folder and just leaving "GRA2307068"
Using the below code, this worked perfectly, and added the hyperlink to the correct cell and linked to the correct word document.
Now I just need to work out how to do it with only a partial match to the folder name, ignoring the hospital name after "GRA2307068"

Any ideas please?

Private Sub Worksheet_Change(ByVal Target As Range)



 Dim GRAPath As String
 Dim GRAFilePath As String
 Dim GRAFileName As String
  
    GRAPath = "T:\Operations\Inventory\GRA\GRAs\GRAs - 2023\07 - July 2023\"
    
    If Target.Count = 1 And Target.Column = 6 And Target.Row >= 2 Then
        If Left(Target.Value, 4) = "2307" Then
            GRAFileName = "GRA" & Target.Value
            GRAFilePath = GRAPath & GRAFileName & "\" & GRAFileName & ".docx"
            'MsgBox GRAFilePath
                If Dir(GRAFilePath) <> "" Then
                    Target.Hyperlinks.Add Target, GRAFilePath
                End If
        End If
    End If

End Sub

 

[paun_shotts]

After some more research I have found a solution that works for me.

Private Sub Worksheet_Change(ByVal Target As Range)

Const staticFolder = "T:\Operations\Inventory\GRA\GRAs\GRAs - 2023\07 - July 2023\"

Dim Foldername As String, GRAFileName As String
Dim doc As String
 If Target.Count = 1 And Target.Column = 6 And Target.Row >= 2 Then
        If Left(Target.Value, 4) = "2307" Then
            GRAFileName = "GRA" & Target.Value
        End If
 End If

Foldername = Dir(staticFolder & GRAFileName & "*", vbDirectory)
doc = GRAFileName & ".docx"
 If Foldername <> "" Then
        Target.Hyperlinks.Add Target, staticFolder & Foldername & "\" & doc
    Else
        MsgBox "GRA document not found."
    Exit Sub
 End If

End Sub