Çözüldü Klasör içerisindeki pdflerin listesini excele aktarma (Linkli) Yardım

hasanyaprak

Altın Üye
Katılım
9 Aralık 2010
Mesajlar
69
Excel Vers. ve Dili
İş office 2021 / Ev ofis 2016 64 bit
Altın Üyelik Bitiş Tarihi
13-10-2025
Merhaba,

Ekte çalışan bir makrom var. Her seferinde sabit bir klasörden çekiyorum ama kullandığım makro browse olarak açılıyor ve klasörü tanıtmak zorunda kalıyorum. E1 hücresine girdiğim yoldan almasını istersem ne yapmalıyım. Browse özelliğinin iptal olmasını istiyorum ama yine linkli olarak kullanmalıyım. Yardımınız için teşekkür ederim şimdiden.
 

Ekli dosyalar

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,164
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Bunu deneyiniz.
Kod:
Sub Kopru_Ekle()
    Dim KlasorYolu As String
    Dim Dosya As String
    Dim X As Long

    KlasorYolu = Range("E1").Value

    If KlasorYolu = "" Then
        MsgBox "Klasör yolunu kontrol ediniz!", vbExclamation
        Exit Sub
    End If

    Range("A:A").Clear
    Range("A1") = "Dosya Bağlantıları"
    
    Dosya = Dir(KlasorYolu & "\*.*")

    While Dosya <> ""
        DoEvents
        X = Cells(Rows.Count, 1).End(3).Row + 1
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(X, 1), _
        Address:=KlasorYolu & "\" & Dosya, TextToDisplay:=Dosya
        Dosya = Dir
    Wend

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 

hasanyaprak

Altın Üye
Katılım
9 Aralık 2010
Mesajlar
69
Excel Vers. ve Dili
İş office 2021 / Ev ofis 2016 64 bit
Altın Üyelik Bitiş Tarihi
13-10-2025
Bunu deneyiniz.
Kod:
Sub Kopru_Ekle()
    Dim KlasorYolu As String
    Dim Dosya As String
    Dim X As Long

    KlasorYolu = Range("E1").Value

    If KlasorYolu = "" Then
        MsgBox "Klasör yolunu kontrol ediniz!", vbExclamation
        Exit Sub
    End If

    Range("A:A").Clear
    Range("A1") = "Dosya Bağlantıları"
   
    Dosya = Dir(KlasorYolu & "\*.*")

    While Dosya <> ""
        DoEvents
        X = Cells(Rows.Count, 1).End(3).Row + 1
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(X, 1), _
        Address:=KlasorYolu & "\" & Dosya, TextToDisplay:=Dosya
        Dosya = Dir
    Wend

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Hocam teşekkür ederim, çok işime yaradı. Exceli boş yüklemişim kusura bakmazsın umarım.
 
Üst