Dosya içindeki klasör isimlerini excelde listeleme

[modoste]

merhaba sayın hocalarım
az önce google da da aynıbu adla arattığım sorumda excel forumdan bi ara yılında sorulmuş ve cevaplanmış bi çözüm gördüm

benimde sorum şu bilgisayarımda
Depo 2 (E) içinde
Download Film-Müzik-Belge diye bi klasör var ve bu klasör içinde 441 tane klasör var ben bu kalsör adlarının listesini bulmak istiyorum
bu klasörü boşalttıktan sonra tekrar download edilen klasörler burda toplancak ve adlarını arşiv yapmak istiyorum
çözüm ve yardım bekliyorum

bu eski sorundaki hocamızın yazdığı mod
Sub Alt_Klasör_İsimleri()
Dim ds, f, f1, fc, s
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder("C:\Belgelerim")
Set fc = f.SubFolders
For Each f1 In fc
s = s & f1.Name
s = s & vbCrLf
Next
MsgBox s
End Sub

ben bu kısımda ("C:\Belgelerim") kısmını
("Depo 2 (E) :\Download Film-Müzik-Belge") diye yapmaya çalıştım ama olmadı
bilgisayarımı tıkladığımda
Depo 2 (E tıklıyorum ve peşine
Download Film-Müzik-Belge tıklıyorum klasörler bunun içinde bir yerde hata yapıyorum ama nerde

 

[halit3]

bu kodu denermisiniz.

Sub Alt_Klasör_İsimleri()
Columns("A:A").ClearContents
Dosya ("D:\")
MsgBox "işlem tamam"
End Sub
Sub Alt_Klasör_İsimleri2()
Columns("A:A").ClearContents
Dim Klasor As Object
Set Klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasor seçin !", 1)
If Not Klasor Is Nothing Then
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
Dosya (Klasor.items.Item.Path)
Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
Private Sub Dosya(Yol As String)
Dim fL As Object, f As Object, j As String
On Error Resume Next
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(Yol).SubFolders
On Error GoTo sonraki
For Each f In fL
j = Worksheets(ActiveSheet.Name).[a65536].End(xlUp).Row + 1
Cells(j, 1) = f.Path
sonraki:
On Error Resume Next
Dosya (f.Path)
Next
Set fL = Nothing
End Sub

 

[modoste]

sayın halit 3
şunları yaptım masaüstünde yeni bi excel sayfası açtım
alt+f11 ile açılan sayfada ınsert/module dedim
açılan ekrana kodu yaıştırdım
enter demeden önce
Bilgisayarım tıkladığımda açılan sürücüler disklerden benim aradığım klasör
Depo 2 (E tıkladığımda içinde Download 2010 klasörü koddaki dosya yerini değiştim
! işaretini silmedim
ve sürücü olan yeri bi orjinal bıraktım olmadı bi Depo 2 yazdım yine olmadı

 

[modoste]

Bilgisayarım
Depo 2 (E
Download 2010 (klasörler burda)
kodda belkide değişecel yerler var belki bi tırnak işareti belki parantez artık tam bilemediğimden

 

[halit3]

Bilgisayarım
Depo 2 (E
Download 2010 (klasörler burda)
kodda belkide değişecel yerler var belki bi tırnak işareti belki parantez artık tam bilemediğimden

haklısın dosyayı gönderiyorum

 

[modoste]

sayın hocam düğme 2 süper bi çözüm olmuş listeledi altalta düğme 1 e tıkladığıda kilitlendi ekranım o neyi listeliyodu anlayamadım
makrolar konusunu çok iyi bilmiyorum

sayın hocam ben aslında bu tarz bi soruyu genel bilgisayar konusuna girdiğinden çabucak listeleyen bişe yapılabilirmi diye genel aratırken bizim excl.web.tr forumuna daha önceden sorulmuş soruyla karşılaştım
bende zaten bu listelemeyi başarırsam listeden kopyalayıp excelde başka bi dosyaya taşıyacaktım
excelin bi çözümü olduğunu anlayınca öğrenmek istedim
çok teşkkürler tekrar

 

[halit3]

diğeri d sürücüsünün içindeki klasörleri tarıyordu

 

[modoste]

sayın halit3 hocam
klasörleri sıralama olayını çok kullanışlı şekilde kullanıyorum artık
peki hocam klasörlerin içindeki dosyaları gösteren kodu yapabilirmiyiz?

bu soruyu sorma nedenim benim download 2010 dosyamda şarkıların olduğu klasörler var ve her klasörün içinde en az 15 tane şarkı adı var.
şu ana kadar şarkı klasörlerini dosyaladık süper çalışmanızla
acaba klasöründe içine girip klasörün içinde ne varsa adını yazan kodu yapabilirmiyiz?

 

[halit3]

ekli dosyayı inceleyiniz.

 

[modoste]

sayın hocam örneği çalıştırdım butonlardan 4 tane yapmışsınız en sağdan 2. butona Seçili klasördeki dosyaları bul olarak değiştirip ekleyebilirmisiniz
hani karıştırıp en sağdakine basında nerdeyse kilitleniyo karıştırmamak adına Gri butonda yazan adı değiştircez yani.

 

[halit3]

mause ile düğmenin üzerine sağ tıkla düzenleme kutusunu seç ve ismini değiştir.

 

[modoste]

sayın hocam bilmediğimden basit bişe sormuşum kusuruma bakmayın
teşekkür ettim hemen uyguladım

bundan sonra belirli bi klasörde topladığım film yada müzik her ne varsa birine anlatmaktanda bu şekilde biryere çıktısını alıp mail vs gönderebilcem çok zamandır uğraşıyodum ama doğru yerde aramıyomuşum
çok alternatifli bi çalışma hazırlamış oldunuz bana çok teşekkürler hocam.

 

[modoste]

sayın hocam son bir sorum var
ben XP işletim sistemi kullanıyorum
windows 7 yada daha başka bi işletim sistemi kurulsa bilgisayarıma bu dosya
doğru sonuçlar verir mi?

 

[halit3]

doğru sonuçları vermesi lazım bir sıkıntı olmaz sanırım.

iyi çalışmalar

 

[modoste]

kısa süre içinde format değişebilirim sayın hocam eğer sıkıntılı durum olursa size tekrar dönerim
teşekkür ederim.

 

[erkaan]

Slm. Halit3
çok uğraşıp da başaramadığım birçok işlemi yayınladığınız

Sub Alt_Klasör_İsimleri()
Columns("A:A").ClearContents
Dosya ("D:\")
MsgBox "işlem tamam"
End Sub
Sub Alt_Klasör_İsimleri2()
Columns("A:A").ClearContents
Dim Klasor As Object
Set Klasor = CreateObject("Shell.Application").BrowseForFolder( 0, "Lütfen bir klasor seçin !", 1)
If Not Klasor Is Nothing Then
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
Dosya (Klasor.items.Item.Path)
Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
Private Sub Dosya(Yol As String)
Dim fL As Object, f As Object, j As String
On Error Resume Next
Set fL = CreateObject("Scripting.FileSystemObject").GetFold er(Yol).SubFolders
On Error GoTo sonraki
For Each f In fL
j = Worksheets(ActiveSheet.Name).[a65536].End(xlUp).Row + 1
Cells(j, 1) = f.Path
sonraki:
On Error Resume Next
Dosya (f.Path)
Next
Set fL = Nothing
End Sub

bu kod yardımı ile hallettim elinize sağlık.
ama sizden bir ricam var bu kodu yanlızca klasör içindeki dosyalar için değilde ana klasör isimleri için ayarlayabilirmisiniz? Çünkü Bana taşınabilir bellek üzerindeki klasör isimlerini listelemesi lazımbirkaç kod buldum ama hep alt dosyaları listeliyor. şimdiden teşekkürler

 

[halit3]

bunu denermisiniz.

Sub bütünklasörleribul()
Columns("A:A").ClearContents
Dim Klasor As Object
Set Klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasor seçin !", 1)
AltListe (Klasor.items.Item.Path)
Set Klasor = Nothing
MsgBox "işlem tamam"
End Sub
Private Sub AltListe(Yol As String)
Dim fL As Object, f As Object, Dosya As String, j As Long
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(Yol).SubFolders
On Error GoTo sonraki
For Each f In fL
j = WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("A1:A65000")) + 1
Cells(j, 1) = f.Path
sonraki:
On Error Resume Next
AltListe (f.Path)
Next
Set fL = Nothing
End Sub

 

[erkaan]

İlginiz için teşekkür ederim. bu işimi gördü. Lakin iki ayrı problemim var
birincisi gizli sistem dosyalarını görmek istemiyorum onları da listeledi.
ikincisi listede mevcut olan listenin üzerine yazdı.listelemeyi mevcut listenin bitim yerin den veya tıklamış olduğum hücreden itibaren listelettirebilirmiyiz.
başarılar dilerim.

 

[halit3]

İlginiz için teşekkür ederim. bu işimi gördü. Lakin iki ayrı problemim var
birincisi gizli sistem dosyalarını görmek istemiyorum onları da listeledi.
ikincisi listede mevcut olan listenin üzerine yazdı.listelemeyi mevcut listenin bitim yerin den veya tıklamış olduğum hücreden itibaren listelettirebilirmiyiz.
başarılar dilerim.

bunu silerseniz devamlı alt alta aktaracaktır.

Columns("A:A").ClearContents

 

[erkaan]

selam halit3
bilmek kadar değerli servet yok sanırım. Allah zihin açıklığı versin. şimdi daha güzel oldu. başarılar