Klasör içerisindeki dosya isimlerini excel sayfasına almak

[ASLAN7410]

Merhaba hayırlı akşamlar.

Bilgisayarım masa üzerinde ÇALIŞMA diye bir klasörüm var bunun içerisinde 1000 adet pdf ve excel
dosyalarım var, bu dosya isimlerini bir excel sayfasının B2 sütunundan aşağıya doğru almak istiyorum.

Yardım edecek arkadaşlara şimdiden teşekkür ederim.

 

[Orion1]

Buyurun.
sizin dosyanız masa üstünde olsun.

Sub dosyalar59()
Dim dosya, sat As Long
Range("B:B").ClearContents
sat = sat + 1
dosya = Dir(ThisWorkbook.Path & "\ÇALIŞMA\*.xls*")
Do While dosya <> ""
    Range("B" & sat).Value = dosya
    dosya = Dir
    sat = sat + 1
Loop
dosya = Dir(ThisWorkbook.Path & "\ÇALIŞMA\*.pdf")
Do While dosya <> ""
    Range("B" & sat).Value = dosya
    dosya = Dir
    sat = sat + 1
Loop
MsgBox "Dosyalar listelendi." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[ASLAN7410]

Sayın Evren ilginizi için çok teşekkür ediyorum.

Makroyu çalıştırdığımda sadece Dosyalar listelendi mesajı ekrana geliyor, dosya isimleri listelenmiyor.

 

[Orion1]

Sayın Evren ilginizi için çok teşekkür ediyorum.

Makroyu çalıştırdığımda sadece Dosyalar listelendi mesajı ekrana geliyor, dosya isimleri listelenmiyor.

sizin dosyanız masa üstünde olmalı.
Çalışma klasörüde masa üstünde olmalı.
Listelenecek dosyalar bu çalışma klasörü içinde olmalı.

 

[ASLAN7410]

Tamamdır Evren Bey listelenmesini istediğim dosyayı klasör içerisinden çıkardığımda çalıştı.

Çok teşekkür ediyorum, Allah razı olsun.
Hayırlı çalışmalar.

 

[Orion1]

Tamamdır Evren Bey listelenmesini istediğim dosyayı klasör içerisinden çıkardığımda çalıştı.

Çok teşekkür ediyorum, Allah razı olsun.
Hayırlı çalışmalar.

Rica ederim.
İyi çalışmalar.

 

[ASLAN7410]

Evren Bey yeni fark ettim küçük bir sorun var, dosya isimleri listelendiği zaman dosyanın uzantılarıda geliyor, bunları yok edebilir misiniz?

 

[Orion1]

Evren Bey yeni fark ettim küçük bir sorun var, dosya isimleri listelendiği zaman dosyanın uzantılarıda geliyor, bunları yok edebilir misiniz?

Buyurun.

Sub dosyalar59()
Dim dosya, sat As Long, dosya2
Range("B:B").ClearContents
sat = sat + 1
dosya = Dir(ThisWorkbook.Path & "\ÇALIŞMA\*.xls*")
Do While dosya <> ""
    Range("B" & sat).Value = Replace(dosya, ".xlsx", "")
    dosya = Dir
    sat = sat + 1
Loop
dosya = Dir(ThisWorkbook.Path & "\ÇALIŞMA\*.pdf")
Do While dosya <> ""
    Range("B" & sat).Value = Replace(dosya, ".pdf", "")
    dosya = Dir
    sat = sat + 1
Loop
MsgBox "Dosyalar listelendi." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[ASLAN7410]

Evren valla süper oldu, çok teşekkür ediyorum.

Hayırlı çalışmalar dilerim.

 

[Orion1]

Evren valla süper oldu, çok teşekkür ediyorum.

Hayırlı çalışmalar dilerim.

Rica ederim.
İyi çalışmalar.