Soru Alt klasör altındaki verileri getirme kodunda revize

[valentino06]

Merhaba Arkadaşlar aşağıdaki kodu forumda buldum. Hocam yolunu değiştirmek istiyorum. alt klasörler içindeki veriyi getirsin. istiyorum lütfen yardımcı olabilir misiniz.çok teşekkür ederim.

Sub dosyalar()
Dim STR As Long, YL As String, DSY As String
STR = 2
YL = "C:\abbbbb\" 'buraya klasörün yolunu yazın c dizini abc klasöründeki dosyaları listeler
DSY = Dir(YL, vbNormal)
Do While DSY <> ""
With WorksheetFunction
If (GetAttr(YL & DSY) And vbNormal) = vbNormal Then
Cells(STR, "A") = Replace(DSY, Right(DSY, Len(DSY) - _
.Find("*", .Substitute(DSY, ".", "*", Len(DSY) - Len( _
.Substitute(DSY, ".", "")))) + 1), "")
STR = STR + 1
End If: End With
DSY = Dir
Loop
End Sub

 

[RBozkurt]

Seçtiğiniz klasördeki verileri listeler. Deneyiniz.

Sub dosyalar()
Dim STR As Long, YL As Variant, DSY As String
STR = 2
YL = BrowseForFolder("Dosyaları Seçin")
DSY = Dir(YL & "\*.*", vbNormal)
Do While DSY <> ""
With WorksheetFunction
If (GetAttr(YL & "\" & DSY) And vbNormal) = vbNormal Then
Cells(STR, "A") = Replace(DSY, Right(DSY, Len(DSY) - _
.Find("*", .Substitute(DSY, ".", "*", Len(DSY) - Len( _
.Substitute(DSY, ".", "")))) + 1), "")
STR = STR + 1
End If: End With
DSY = Dir
Loop
End Sub

Private Function BrowseForFolder(Optional OpenAt As Variant) As Variant
    Dim ShellApp As Object
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Klasör Seçin", 0, OpenAt)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
    Set ShellApp = Nothing
    Select Case Mid(BrowseForFolder, 2, 1)
        Case Is = ":"
            If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
        Case Is = "\"
            If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
        Case Else
            GoTo Invalid
    End Select
    Exit Function
Invalid:
    BrowseForFolder = False
End Function

 

[Muzaffer Ali]

Merhaba.
İnceleyiniz.

"Alt Klasörleri" ve "Alt Klasörlerdeki Tüm Dosyaları" Listeleme

 

[valentino06]

Hocam Rbozkurt Hocam verileri getirmedi. Sayın Muzaffer Ali hocam vermiş olduğunuz link inceledim. verileri getiriyor. yalnız yolu da yazıyor. ben sadece veriler gelsin. istiyorum.

 

[RBozkurt]

Hocam Rbozkurt Hocam verileri getirmedi. Sayın Muzaffer Ali hocam vermiş olduğunuz link inceledim. verileri getiriyor. yalnız yolu da yazıyor. ben sadece veriler gelsin. istiyorum.

Sizin eklediğiniz koda sadece KLASÖR ekleme işlevi değişti. Kodda değişiklik yapılmadı.


Altta kendi kullandığım bir uygulama var belki işinize yarar.

 

[valentino06]

Sayın RBozkurt Hocam sizden ricam alt klasöre yol gösterek yapma olasılığımız olabilir mi lütfen çok teşekkür ederim.

 

[valentino06]

Hocam Örnek C:\Users\m\Desktop\U\Kalınlıklar\

 

[RBozkurt]

Elinizde örnek DENEME diye bir klasör var, Bunu içindede DENEME2 diye klasör var.
Siz ana klasör ve bunun içinde bulunan ALT klasörleri içindekiler ile birlikte mi yazdırmak istiyorsunuz?

Yoksa listelenecek klasörü yukarıdaki gibi adresi el ile girerek aratmak mı ben soruyu anlayamadım şuan.

2. seçenekse eğer İlk kod listeleme yapıyor. Orda listelenecek klasör yolu inputboxa bağlanabilir. Makro çalışınca adresi el ile yapıştırırsınız ve listeler.

 

[valentino06]

Hocam evet kod çalışıyor. çok teşekkür ederim. sadece alt klasör içindekileri yazdırmak istiyorum. benim paylaştığım kodun sıkıntısı alt klasör ismi değişken olduğu için sürekli yeni yol girmek zorunda kalıyordum. eğer alt klasöre klasör seçtirmeden direk bir bağlantı yapılabilirse alt klasör içinde ne kadar değişiklik olsa da verileri direk getirir ve yazar diye düşünüyorum. tabi yapılabilirse

 

[valentino06]

Arkadaşlar lütfen yardımcı olabilirmisiniz. Çok teşekkür ederim

 

[RBozkurt]

Arkadaşlar lütfen yardımcı olabilirmisiniz. Çok teşekkür ederim

Aşağıdaki dosya yolu ile listeliyor. Deneyiniz.
Kaynağından alıntıdır.

 

[valentino06]

Tamam hocam çok teşekkür ederim. Yarın iş yerinde denerim ve dönüş yaparım.