Dosya ve Dizin Yüklemek

[neo]

:hey: Herkese merhablar

elimde oldukça büyüyen ve karmaşık bir hal alan bir arşivim var aradığımı bulmam ve incelemem zorlaşıyor buna bir çözüm ürettim ama tabiki makroyu yazmayı becermem oldukça zor siz değeri dostlarımdan yardım bekliyorum bir örnek dosya hazırladım bana bu konuda yardımcı olursanız sevinirim

Saygı ve sevgilerimle

 

[neo]

:hey: sevgili dostlar merhabalar

dostlar enazında bir fikir bir öneriye ihtiyacım var

 

[serdenm]

buna benzer bir kod var:
(sayin leventm'nin yazdigi).
"belirli bir dizindeki dosyaları indeksleme ve köprü oluşturma" isimli basligi incelemenizi tavsiye ederim. en azindan bir fikir verebilir.
http://www.excel.web.tr/viewtopic.php?t=14854

selamlar.

 

[neo]

:hey: Merhabalar

kardşim eyvallah ilgine teşekkurederim ama tam olarak istediğim bu değidi. heralde bu işin çözümü zor galiba

 

[Levent Menteşoğlu]

Bu istediğinizi yapmak gerçekten çok kolay değil belki listview veya treeview nesneleri ile birşeyler yapılabilir aslında yukrıda size önerilen linkte güzel kodlar mevcut onlardanda istifade edebilirsiniz. Bunun yerine direk olarak istediğiniz klasörü açan bir kod yazılabilir. Aşağıdaki kodu deneyin.

[vb:1:bff88c297f]Sub klasorac()
Set ObjFolder = CreateObject("Shell.Application").BrowseForFolder _
(0, "Lütfen bir klasor seçin !", &H100)
MyPath = ObjFolder.Items.Item.Path
MsgBox MyPath
End Sub
[/vb:1:bff88c297f]

 

[serdenm]

merhaba leventm.
bu kalsor acma kodunu asagidaki belirli klasoru indeksleyen koda nasil uyarlayabiliriz?
iyi gunler.


Sub linkver()
Range("a:a").ClearContents
Dim col As New Collection
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")

col.Add "c:\downloads"
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

 

[veyselemre]

[vb:1:8015c602ac]Sub linkver()
Set ObjFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasor seçin !", &H100)
mypath = ObjFolder.Items.Item.Path
Set ObjFolder = Nothing
If mypath = "" Then Exit Sub

Range("a:a").ClearContents
Dim col As New Collection
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")

col.Add mypath
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:8015c602ac]

 

[neo]

merhaba

:hey: merhaba

merhabalar dostlarım evet güzel örnekler vermişsiniz ben bunları bileştirmeye çalışacağım inşallah başarılı olabilirim yardımlarınızdan dolayı çok teşekkurederim

saygı ve sevgilerimler

 

[serdenm]

veyselemre tekrar selam,

artik kod son halini aldi gibi. fakat ilk basta leventm nin verdigi kodda sadece dosya isimleri gozukuyordu. senin kodda ise path i ile birlikte gozukuyor. gerci bu bazi uygulamalarda oldukca ise yarayabilir, fakat cok kademeli alt dizinlerde link acaip uzuyor. buna nasil bir cozum getirebiliriz?

iyi pazarlar...

 

[veyselemre]

[vb:1:082b5cc120]ActiveSheet.Hyperlinks.Add Anchor:=Cells(t, 1), Address:=dosya.Path, TextToDisplay:=dosya.Name[/vb:1:082b5cc120]

olarak dene