Soru Klasör Altındaki Excel adreslerini yazdırma

[bulentkars]

Arkadaşlar Merhaba

C:/Yedek/ Klasörü içinde birden fazla Excel çalışma kitapları var. Ben bu çalışma kitaplarının dosya isim ve uzantılarını A sütununa yazdırmak istiyorum.
Örneğin
C:\Yedek\ödemeler.xlsx
C:\Yedek\Borçlar.xlsm
C:\Yedek\Alacaklar.xlsb

Bu şekilde A2 den itibaren yazdırmak istiyorum. yardımcı olabilirseniz sevinirim. Şimdiden Teşekkürler

 

[Korhan Ayhan]

İnceleyiniz. Bolca örnek var.

Klasördeki dosya isimlerini listeleme

 

[bulentkars]

Korhan Bey Merhaba

İnceledim yapılanlar sadece ilgili klasörün altındaki dosya isimlerini listeliyor.
Benim istediğim uzantı adresleri dahil listelemek.

Örnekte gösterdiğim gibi listelenmesini istiyorum.
C:\Deneme\raporlar.xls şeklinde lşstelenmesinş istiyorum.

 

[NBATMAN]

Günaydın,

Ekte bu iş için yazdığım bir program var. Bir bakın isterseniz, işinize fazlasıyla çözer.

 

[bulentkars]

Merhaba,

Güzel bir program yapanın emeğine sağlık, ancak ben bunun için excel içerisinde bir makroya ihtiiyacım var, çalıştırdığım anda direk ilgili klasör altındaki dosyaların a sutununa yazmak istiyorum.

 

[Greenblacksea53]

Sub Klasordeki_dosyalar()
Dim dosya, dc, yol
Set dosya = CreateObject("Scripting.FileSystemObject")
Set yol = dosya.GetFolder("C:\Yedek")
Set dc = yol.Files
For Each dosya In dc
c = c + 1
Cells(c, 1) = dosya.Name
Next
End Sub

Denermisin

 

[bulentkars]

Merhaba,

Bu kod sadece dosya adı ve uzantısını veriyor. Sizin paylaştığınız Şu şekilde veriyor.ÖRNEK.XLSX benim istediğim C:\YEDEK\ÖRNEK.XLSX

 

[Greenblacksea53]

Merhaba,

Bu kod sadece dosya adı ve uzantısını veriyor. Sizin paylaştığınız Şu şekilde veriyor.ÖRNEK.XLSX benim istediğim C:\YEDEK\ÖRNEK.XLSX

Cells(c, 1) = yol & dosya.Name

Bu kodu ekleyin..

 

[Korhan Ayhan]

Anladığım kadarıyla verilen örnekleri kendinize uyarlayacak makro bilginiz sanırım yok. Biraz çaba sarf etseniz aslında kolayca öğrenebilirsiniz.

Alternatif olarak aşağıdaki kodu deneyebilirsiniz.

Option Explicit

Sub My_Folder_File_List()
    Dim File_Path As String, My_File As String
    
    Range("A:A").Clear
    Range("A1") = "Dosya Listesi"
    
    File_Path = "C:\Yedek\"
    
    My_File = Dir(File_Path & "*.xls*")
    
    While My_File <> ""
        Cells(Rows.Count, 1).End(3)(2, 1) = File_Path & My_File
        My_File = Dir
    Wend
    
    Columns("A").AutoFit
    
    If Range("A2") = "" Then
        MsgBox "Kritere uygun dosya bulunamadı!", vbCritical
    Else
        MsgBox Cells(Rows.Count, 1).End(3).Row - 1 & " adet dosya listelenmiştir...", vbInformation
    End If
End Sub

 

[bulentkars]

Korhan Bey,

Çok Çok Teşekkür ederim. Elinize sağlık