Dizin İçerisindeki Dosya Adlarını Yazdırma

[iibfli]

Merhaba

Bir klasör içerisindeki excel dosyalarının adlarını excelde bir sütuna yazdırabilir miyiz?

 

[Necdet]

Merhaba,

Gerektiğinde sadece dosya adınıda yazdırabilrsiniz.

Not : Kodlar bu siteden alıntıdır.

Sub Basla()
Dim Klasor As Object
Set Klasor = CreateObject("Shell.Application").BrowseForFolder _
                    (0, "Klasör seçiniz !", 1)
                    
If Klasor Is Nothing Then Exit Sub
Range("A2:A65536").Clear
[A1] = "Dosya Yolu ve Dosya Adı"
Liste (Klasor.Items.Item.Path)
AltListe (Klasor.Items.Item.Path)
 
Set Klasor = Nothing
End Sub

Private Sub Liste(yol As String)
Dim dosya As String, i As Long
 
    dosya = Dir(yol & "\*.*")
    i = 1
    While dosya <> ""
        DoEvents
        i = i + 1
        Cells(i, 1) = yol & "\" & dosya
        dosya = Dir
    Wend
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
    dosya = Dir(f.Path & "\*.*")
    
    While dosya <> ""
        DoEvents
        j = [a65000].End(3).Row + 1
        Cells(j, 1) = yol & "\" & dosya
        dosya = Dir
    Wend
    
    AltListe (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub

 

[iibfli]

Teşekkürler üstadım.