Dosya Listeleme Kodunda Değişiklik..

[EKREM1661]

Arkadaşlar..! Aşağıda ki kod, diyalog kutusu ile seçilen bir klasörde bulunan dosyaları A sütununa listeliyor..

Ancak, listelediği dosya isimlerine uzantılarını da ekliyor.. Uzantıları eklettirmemek için kodu nasıl düzenleriz.. (Örneğin xxxx.JPG değil de, sadece xxxx olarak)

Bir de, A1 den listeliyor, A2 den listelemesi lazım..

Sub DosyaListeleme()
[a:a].ClearContents
Set klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen dosyaları listelenecek klasörü seçin !", &H100)
yol = klasor.Items.Item.Path
If yol = "" Then Exit Sub
Set nesne = CreateObject("Scripting.FileSystemObject")
Set dosyalar = nesne.GetFolder(yol)
Set liste = dosyalar.Files
For Each dosya In liste
c = c + 1
Cells(c, 1) = dosya.Name
Next
End Sub

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

 

[Orion1]

Buyurun.

Sub DosyaListeleme()
    [a:a].ClearContents
    Set klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen dosyaları listelenecek klasörü seçin !", &H100)
    yol = klasor.Items.Item.Path
    If yol = "" Then Exit Sub
    Set nesne = CreateObject("Scripting.FileSystemObject")
    Set dosyalar = nesne.GetFolder(yol)
    c = 2
    On Error Resume Next
    For Each dosya In dosyalar.Files
    j = nesne.getextensionName(dosya)
    Cells(c, 1).Value = Left(dosya.Name, Len(dosya.Name) - (Len(j) + 1)) 'sadece Dosya adı.Uzantısız.
    c = c + 1
    Next
End Sub

 

[EKREM1661]

Sn.Evren hocam..! Çok teşekkür ederim...İyi akşamlar dileğiyle..