belirli bir dizindeki dosyalar indeksleme ve köprü oluşturma

[serdenm]

merhaba,

ornegin c:\datasheet diye bir directory oldugunu varsayalim. ve bu dizinin icinde 500 adet dosya.
bir makro ile bu dosyalarin isimlerini excel e tasiyarak dosyalarin herbirine link (kopru) olusturabilirmiyiz?

ornegin a1 de "deneme.doc" yazacak ve üstüne tıklandığında o dosya açılacak.

tesekkurler.

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

[vb:1:1c6bfb45ed]Sub linkver()
Set yol = CreateObject("Scripting.FileSystemObject").GetFolder("c:\datasheet").Files
For Each dosya In yol
c = c + 1
ActiveSheet.Hyperlinks.Add Anchor:=Cells(c, "a"), Address:="c:\datasheet\" & dosya.Name, TextToDisplay:=dosya.Name
Next
End Sub
[/vb:1:1c6bfb45ed]

 

[serdenm]

Merhaba Leventm,
Tebrik ederim, müthiş calisiyor!!!
:bravo:
ancak iki kucuk sorum daha var:
1. indekslemeye altdizinleri nasil dahil edebiliriz?
2.birde her linke bastigimda guvenlik uyarisi cikiyor:"kopruler zarar verebilir" seklinde, nasil engelleyebiliriz.

Cok tesekkur ederim.

iyi aksamlar... :hey:

 

[Levent Menteşoğlu]

1-Alt klasörleri ilave edersek kod biraz karmaşık hale gelecektir. Alt klasör sayısı ve isimleri nelerdir.

2-Bu uyarı sanıyorum, kodu kayıtlı olmayan bir dosyada denediğinizden ortaya çıkıyor, dosyayı kaydederseniz çıkmaması gerekir.

 

[serdenm]

1.alt klasörler
2002, 2003, ... , 2006 ve her kalsorun altinda yine cok sayida veri var.
bunlari ayri sutunlara indeksleme yapabilirmiyiz? a sutununa 2002, b ye 2003 şeklinde.


2. evet haklisiniz. artik uyari vermiyor.

yardiminiz icin tesekkur ederim. :hey:

 

[veyselemre]

Levent Beyin Kodlarını aşağıdaki şekilde değiştirseniz, alt klasörleri de alır
[vb:1:180bde3127]Sub linkver()
Set fc = CreateObject("Scripting.FileSystemObject")
Set yol = fc.GetFolder("c:\datasheet").Files

For Each dosya In yol
c = c + 1
ActiveSheet.Hyperlinks.Add Anchor:=Cells(c, "a"), Address:="c:\datasheet" & dosya.Name, TextToDisplay:=dosya.Name
Next

Set f_yollar = fc.GetFolder("c:\datasheet").subfolders

For Each f_path In f_yollar
For Each dosya In f_path.Files
c = c + 1
ActiveSheet.Hyperlinks.Add Anchor:=Cells(c, "a"), Address:="c:\datasheet\" & dosya.Name, TextToDisplay:=dosya.Name
Next
Next

End Sub[/vb:1:180bde3127]

 

[serdenm]

sayin veyselemre,

bu sefer 2 adet problemim var:

1. sadece 1. düzey alt kalsörleri listeliyor. yani c:\datasheets\2002\1\ dizinini almiyor. sadece c:\datasheets\2002 klasörü altindakileri aliyor.

2. hyperlinklerin hic biri çalışmıyor.
sadece c:\datasheets altindakilerin linki calisiyor. diger altdizindeki dosyalarida c:\datasheets in altinda ariyor. halbuki bir alt dizinde aramali. bu yuzden dosya acilamiyor uyarisi veriyor.

cevaplarinizi bekliyorum, cok tesekkurler. :hey:

 

[veyselemre]

2. sorunuz için alttaki kısmı
ActiveSheet.Hyperlinks.Add Anchor:=Cells(c, "a"), Address:=f_path & "\" & dosya.Name, TextToDisplay:=f_path & "\" & dosya.Name
kodu bu şekilde değiştirin

1. sorunuz için ise alt klasör kırılım sayısı belli ise çözüm üretilebilir.

 

[serdenm]

ornegin 5 seviye altdizin dersek:
c:\datasheets\2002\1\a\akrilik\

herhalde tum altdizinleri otomatik olarak macro ile excel alamiyor?

iyi gunler.

 

[Levent Menteşoğlu]

herhalde tum altdizinleri otomatik olarak macro ile excel alamiyor?

Bunun için çok sayıda döngü kullanılarak bir kod yazılabilir elbette. Ama bu işlem süresini çok uzatacaktır.

 

[serdenm]

simdilik 5 seviye alt dizin icin yazabilirmiyiz kod?

 

[veyselemre]

Aşağıdaki kodları bir deneyerek, sonucu bildirirseniz sevinirim.
Edit:Kodlar revize edildi.
[vb:1:9be135a02a]Sub linkver()
Range("a:a").ClearContents
Dim col As New Collection
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")

col.Add "c:\vemre"
bas = 1: son = 1

tara:
For x = bas To son
yol = col(x)
GoSub alt_dizinleri_bul
Next

If col.Count > son Then
bas = son + 1
son = col.Count
GoTo tara
Else
GoTo dosyalar
End If


alt_dizinleri_bul:
Set fp = fso.GetFolder(yol).subfolders
If Not fp Is Nothing Then
For Each S In fp
col.Add S.Path, S.Path
Next S
End If
Return

dosyalar:
For Each fdir In col
Set Sub_Dir = fso.GetFolder(fdir).Files
For Each dosya In Sub_Dir
t = t + 1
ActiveSheet.Hyperlinks.Add Anchor:=Cells(t, 1), Address:=dosya.Path, TextToDisplay:=dosya.Path
Next dosya
Next fdir

Set Sub_Dir = Nothing
Set fp = Nothing
Set fso = Nothing
End Sub
[/vb:1:9be135a02a]

 

[serdenm]

veyselemre, muthis olmus eline saglik.

tebrikler... k::

digerlerine bilgi olmasi acisindan bunu stabil bir klasor yerine kullaniciya klasor sectirme seklindeyapabiliriz saniyorum. boyle bisey leventm baska bir ornekte yapmisti diye hatirliyorum. onuda yazarsak bu problem son halini almis olur.

Selamlar. :hey: