ilgili düzenlemeyi yaptım. Koddan değişen yerleri görebilirsiniz.
Kod:
Sub Link_Ekle()
Dim lastRow As Long
Dim fileName As String
Dim folderPath1 As String
Dim folderPath2 As String
Dim ws As Worksheet
Dim i As Long
Dim workbookPath As String
Set ws = ThisWorkbook.Sheets(1)
workbookPath = ThisWorkbook.Path
folderPath1 = workbookPath & "\Kasko\"
folderPath2 = workbookPath & "\Trafik\"
lastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row
For i = 2 To lastRow
fileName = ws.Cells(i, 6).Value
If Dir(folderPath1 & fileName & ".pdf") <> "" Then
ws.Hyperlinks.Add Anchor:=ws.Cells(i, 7), Address:=folderPath1 & fileName & ".pdf", TextToDisplay:="Kasko PDF"
Else
ws.Cells(i, 7).Value = "Dosya yok"
End If
If Dir(folderPath2 & fileName & ".pdf") <> "" Then
ws.Hyperlinks.Add Anchor:=ws.Cells(i, 8), Address:=folderPath2 & fileName & ".pdf", TextToDisplay:="Trafik PDF"
Else
ws.Cells(i, 8).Value = "Dosya yok"
End If
Next i
End Sub