Soru Klasör listeleme ve açma işlemi

[sk35]

Merhabalar, bu konu üzerinde forumda çok fazla mesaj var hepsine baktım. Hatta işi gerçekleştiren kodu farklı bir yer de buldum fakat çok karmaşık ve düzenlenemez bir biçimde olduğu için bu konuyu açtım.

Şimdi öncelikle bir yolda yer alan dosyaları excel açıldığında listelemek istiyorum. ve bunlara tıklandığında ise ilgili dosyanın açılmasını istiyorum. Listelemeyi bulduğum bu kod ile yapabiliyorum.

Sub dosya_isimleri()
yol = CreateObject("wscript.shell").specialfolders(10) & "\sonuc"
Set nesne = CreateObject("Scripting.FileSystemObject")
Set klasor = nesne.GetFolder(yol)
Set dosyalar = klasor.Files
For Each dosya In dosyalar
c = c + 1
Cells(c, "a") = Replace(dosya.Name, "." & nesne.GetExtensionName(dosya.Name), "")
Next
End Sub

Fakat sadece isimleri geliyor. Bir kaç yerde açılan diyalog penceresi ile yol seçilen kodu gördüm bunu da istemiyorum. Çünkü her açıldığında ilgili yolu seçmek veya sehven başka yolu seçmek de istemiyorum ve gelen dosya isimlerinin köprülü bir şekilde gelmesini istiyorum. Şimdiden yol gösteren herkese teşekkür ederim.

 

[excelokyanus500]

Deneyin

Sub Dosyalar()

Dim oFSO As Object
Dim klasor As Object
Dim bulunandosya As Object
Dim i As Integer

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set klasor = oFSO.GetFolder("C:\Users\xxxxx\Desktop\sonuc") ' İstediğiniz dosya yolunu yapıştırın

For Each bulunandosya In klasor.Files

    Cells(i + 1, 1) = bulunandosya.Name
    Cells(i + 1, 2) = bulunandosya.Path
    ActiveSheet.Hyperlinks.Add Cells(i + 1, 2), Cells(i + 1, 2).Value 'hyperlinke çevir
    i = i + 1

Next

End Sub

 

[EErkut]

Bir örnek çalışma da ben bırakayım. Sayfa açıldığında siler ve yeniden çeker dosya yolunu.

Private Sub Workbook_Open()
 
    Dim Klasor As String, Dosya As String
    Dim i As Integer
    Sheets("Sayfa1").Cells.Clear
    Klasor = "dosya yolunu buraya yazın"
    Dosya = Dir(Klasor & "*.*", vbNormal)
    i = 1
    Do While Dosya <> ""
        Cells(i, 1) = Dosya
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), Address:= _
        Klasor & "\" & Dosya
        i = i + 1
        Dosya = Dir
    Loop
End Sub

 

[sk35]

Bir örnek çalışma da ben bırakayım. Sayfa açıldığında siler ve yeniden çeker dosya yolunu.

Private Sub Workbook_Open()

    Dim Klasor As String, Dosya As String
    Dim i As Integer
    Sheets("Sayfa1").Cells.Clear
    Klasor = "dosya yolunu buraya yazın"
    Dosya = Dir(Klasor & "*.*", vbNormal)
    i = 1
    Do While Dosya <> ""
        Cells(i, 1) = Dosya
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), Address:= _
        Klasor & "\" & Dosya
        i = i + 1
        Dosya = Dir
    Loop
End Sub

Hocam bu kod çalışsa çok iyi olacaktı fakat çalışmıyor. Hatta açılışa değil makroya atadım öyle de çalışmıyor

 

[Korhan Ayhan]

Bu kısmı revize ettiniz mi?

Klasor = "dosya yolunu buraya yazın"

 

[sk35]

Bu kısmı revize ettiniz mi?

Klasor = "dosya yolunu buraya yazın"

Evet ama üsteki arkadaşımızın kodu çalışıyor.

 

[sk35]

Yeni konu açmamak adına burdan sorayım peki değerli hocalarım, ilgili dosyayı o günün tarihiyle istediğim yola kaydetmek mümkün müdür ? ayrıca gün içerisinde birden fazla dosya kaydedilirse çakışmayacak 06-04-2023.xls, 06-04-2023-2 gibi

 

[EErkut]

Hocam bu kod çalışsa çok iyi olacaktı fakat çalışmıyor. Hatta açılışa değil makroya atadım öyle de çalışmıyor

Ben size çalışan bir örnek bırakıyorum ancak yine aynı şeyi belirteyim yolu kendi sisteminize göre düzenleyin...

 

[Korhan Ayhan]

Ben aşağıdaki gibi denediğimde kod sorun çıkarmadan sonuç verdi.

Klasor = "C:\Test\"

 

[sk35]

Ben aşağıdaki gibi denediğimde kod sorun çıkarmadan sonuç verdi.

Klasor = "C:\Test\"

Hocam Ağ'da bir klasör seçtiğim için çalışmamış olabilir. \\Ortakbilgisayar\dosya gibi bir yol kullandım hocam ondan çalışmamış olabilir. Ama her iki kodda yararlı arşive eklendi. Dosya kayıtla ilgili yazdığım soruya çözümüz var mı hocam araştırma sonucunda aynı isimle birden fazla isimle kayıtta sorun çıktı.

 

[sk35]

Tamam hocam yine sizin forumdaki bir mesajınızdan bu sorunu da çözdüm. Saat eklersek bu sorun da çözülüyor düşünemedim o an.