(18/10/2024, 09:42)boolean_ yazdı: Merhabalar,

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

(18/10/2024, 10:32)cdenktas yazdı:

(18/10/2024, 09:42)boolean_ yazdı: Merhabalar,

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

Günaydın Hocam;

Yapmış olduğunuz kod yükledim. Bu sefer dosya bulunamıyor mesajı verdi .Resim olarak yüklemek istedim ancak kurum engelleme yaptığından yükleyemedim. Acaba nerede hata yapıyorum...