Dosya isimlerini alabilir miyim?

[enginkollu]

:yardim: Merhaba , benim sorum dosya isimleri ile alakalı. Bir klasörüm ve içinde 300 e yakın excel dosyam mevcut. İlk adım olarak tüm dosya isimlerini bir excel sayfasına otomatik yazdırmak istiyorum. Bunu makro ile nasıl yapabilirim. Bir şekilde klasördeki dosyaları tarayıp isimlerini almalıyım. Yardımcı olursanız sevinirim.

 

[zafer]

Merhaba


Aşağıdaki kodlarını modüle yapıştırp çalıştırınız.İstediğiniz Dizindeki kitapları aktif sayfanıza köprü kurarak getirecektir.
Sonra hücrelerdeki istediğiniz kita ismine basarak o kitabı açabilirsiniz.

Dizin ismini kendinize uyarlayınız.

[FONT=Verdana]Sub kopru_kur_excel()[/FONT]
[FONT=Verdana]Dizin = "d:\dosyalar\excel"[/FONT]
[FONT=Verdana]Kitap = Dir(Dizin & Application.PathSeparator & _[/FONT]
[FONT=Verdana]"*.xls", vbDirectory)[/FONT]
[FONT=Verdana]Do While Kitap <> ""[/FONT]
[FONT=Verdana]If Kitap = ThisWorkbook.Name Then GoTo ResumeSub:[/FONT]
[FONT=Verdana]i = i + [/FONT][FONT=Verdana]1[/FONT][FONT=Verdana][/FONT]
[FONT=Verdana]Cells(i, [/FONT][FONT=Verdana]1[/FONT][FONT=Verdana]) = Kitap[/FONT]
[FONT=Verdana]ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, [/FONT][FONT=Verdana]1[/FONT][FONT=Verdana]), _[/FONT]
[FONT=Verdana]Address:=Dizin & Application.PathSeparator & Kitap[/FONT]
[FONT=Verdana]ResumeSub:[/FONT]
[FONT=Verdana]Kitap = Dir[/FONT]
[FONT=Verdana]Loop[/FONT]
[FONT=Verdana]End Sub[/FONT]

 

[enginkollu]

Teşekkürler

Tam olarak istediğim gibi. Çok teşekkür ederim..:hihoho:

 

[matriksx]

Acaba Bu Macroyu İstedİĞİm Satir Ve SÜtÜndan BaŞlatma İmlanimiz Varmi
Varsa Rİca Edİyorum

 

[firstisland]

Merhaba

ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), ...

Cells(i,1)... deki 1 sütunu temsil etmekte. Değiştirildiğinde istenilen sütundan başlatılabilir. " i " ise satırı tesmil etmekte i+1 veya i+2 gibi ilavelerle başlangıç satırını değiştirmek te mümkün.

Herkese iyi çalışmalar...

 

[matriksx]

TeŞekkÜr Ederİm

 

[Necdet]

Bende Makronun Yardımından bulduğum örneği burada paylaşmak isterim.

Sub DosyaBul()
Set Dosyalar = Application.FileSearch
With Dosyalar
    .LookIn = "C:\"   [B][COLOR=teal]'Buraya arama yapacağınız dizini yazınız[/COLOR][/B]
    .SearchSubFolders = False [B][COLOR=teal]'yazdığınız dizinde varsa alt dizinleri de arama yaptıracaksanız değerini True yapınız[/COLOR][/B]
    .Filename = "*.xls"
    If .Execute() > 0 Then
        Buldum = 1
        Adet = .FoundFiles.Count
        For i = 1 To Adet
            Cells(i, "A") = .FoundFiles(i)
        Next i
    End If
End With
End Sub

Paylaşmak istedim