• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

V

valentino06

Katılım
19 Şubat 2007
Mesajlar
630
Excel Vers. ve Dili
Ofis 365 Tr- 64 Bit
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.

Kod: 
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
 
Seçtiğiniz klasördeki verileri listeler. Deneyiniz.

C++: 
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
 
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.
 
valentino06' Alıntı:
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.
Genişletmek için tıkla ...

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.
 

Ekli dosyalar

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.
 
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.
 
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
 
Arkadaşlar lütfen yardımcı olabilirmisiniz. Çok teşekkür ederim
 
Tamam hocam çok teşekkür ederim. Yarın iş yerinde denerim ve dönüş yaparım.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst