Hyperlinks sub folders file - excel

Question

Hello everyone yesterday ı try to do Save Excel Row Via Vba Loop, now my problem is give hyplinks that file via macro.
I try to explain in photo and my codes are below
Sub Hyperlinks()
Dim wks As Worksheet
Dim hl As Hyperlink
Const RootPath As String = "X:\EVEREST-2\EVEREST ERP\ÜRETİM\PDM SOLID DOSYA YOLU\"
Const SeriCol As Long = 3
Const NameCol As Long = 4
Const YearCol As Long = 24
Set wks = ActiveSheet
Dim r As Long: r = FirstRow
Dim FileBaseName As String: FileBaseName = ws.Cells(r, SeriCol)
Dim hl_name As String: hl_name = ws.Cells(r, NameCol)
Dim year As String: year = ws.Cells(r, YearCol)
Do Until Len(hl_name) = 0
wks.Hyperlinks.Add ws.Cells(r, NameCol), Address:=(RootPath & year & "\" & FileBaseName & ".bat"TextToDisplay:=hl_name)
r = r + 1
Loop
MsgBox "Hyperlinks created.", vbInformation End sub

Answer 1

Create Hyperlinks
' *** You want to reference the model cell before and at the end of the loop.
A Quick Fix
Option Explicit
Sub CreateHyperlinks()
Const RootPath As String = "X:\EVEREST-2\EVEREST ERP\ÜRETIM\PDM SOLID DOSYA YOLU\"
Const YearCol As String = "X"
Const SerialCol As String = "C"
Const ModelCol As String = "D"
Const FirstRow As Long = 2
Dim wks As Worksheet: Set wks = ActiveSheet ' improve!
Dim r As Long: r = FirstRow
Dim ModelCell As Range: Set ModelCell = wks.Cells(r, ModelCol) ' ***
Dim FilePath As String
Dim YearPath As String
Dim Serial As String
Do Until Len(CStr(ModelCell.Value)) = 0
YearPath = CStr(wks.Cells(r, YearCol)) & "\"
Serial = CStr(wks.Cells(r, SerialCol))
FilePath = RootPath & YearPath & Serial & ".bat"
wks.Hyperlinks.Add Anchor:=ModelCell, Address:=FilePath
r = r + 1
Set ModelCell = wks.Cells(r, ModelCol) ' ***
Loop
MsgBox "Hyperlinks created.", vbInformation
End Sub

Answer 2

There is a comma missing between ".bat" and TextToDisplay:
Address:=(RootPath & year & "\" & FileBaseName & ".bat"TextToDisplay:=hl_name)
Note: There is no need to use the TextToDisplay parameter when the display text is the same as the anchor cell value.
Refactored Code
Sub Hyperlinks()
Dim wks As Worksheet
Dim hl As Hyperlink
Const RootPath As String = "X:\EVEREST-2\EVEREST ERP\ÜRETIM\PDM SOLID DOSYA YOLU\"
Const SeriCol As Long = 3
Const NameCol As Long = 4
Const YearCol As Long = 24
Set wks = ActiveSheet
Dim r As Long: r = FirstRow
Dim FileBaseName As String: FileBaseName = ws.Cells(r, SeriCol)
Dim year As String: year = ws.Cells(r, YearCol)
Dim Address As String
Do Until Len(hl_name) = 0
Address = RootPath & year & "\" & FileBaseName & ".bat"
wks.Hyperlinks.Add ws.Cells(r, NameCol), Address:=Address
r = r + 1
Loop
MsgBox "Hyperlinks Added"
End Sub

Answer 3

ı fix it now it works
Sub Hyperlinks1()
Dim hl As Hyperlink
Const RootPath As String = "X:\EVEREST-2\EVEREST ERP\ÜRETİM\PDM SOLID DOSYA YOLU\"
Const SeriCol As Long = 3
Const NameCol As Long = 4
Const YearCol As Long = 24
Dim ws As Worksheet: Set ws = ActiveSheet
Dim r As Long: r = 4
Dim FileBaseName As String: FileBaseName = ws.Cells(r, SeriCol)
Dim hl_name As String: hl_name = ws.Cells(r, NameCol)
Dim year As String: year = ws.Cells(r, YearCol)
year = Right(year, 4)
Do Until Len(hl_name) = 0
With ws
.Hyperlinks.Add Anchor:=.Cells(r, NameCol), _
Address:=RootPath & year & "\" & FileBaseName & ".bat", _
ScreenTip:="Click to open 3D Solid File", _
TextToDisplay:=hl_name
End With
r = r + 1
FileBaseName = ws.Cells(r, SeriCol)
hl_name = ws.Cells(r, NameCol)
year = ws.Cells(r, YearCol)
year = Right(year, 4)
Loop
MsgBox "Hyperlinks created.", vbInformation
End Sub