Klasör içerik listelemek hakkında

[drummers]

Ekli dosyam için birkaç isteğim olacaktı.

İsteklerim şunlardır:

1- Listelemeden önce klasörü kendim belirliyebileyim. Klasör ağacı görünümünün olmasını rica etmekteyim

2- <listeleme esnasında en üstten 1 satır boluk bırakmasını rica ediyorum

3- Verilerimi listelerken "A.F.S.CAM AYNA MOBİAL.İM.SAN.TİC.LTŞTİ.__0010584176_FORMBA_01.05.2010_31.05.2010_B.pdf" seklinde listelemekte. Benim istediğim ise isim veye ünvan bittikten sonrasını yazmaması.

örnek: A.F.S.CAM AYNA MOBİAL.İM.SAN.TİC.LTŞTİ.




DÜzeltme :

Benden kaynaklı bir hata var. Kusurma bakmayım.

Listelediğim klasörü yanlış seçmişim. Listelenen verilerim aynen söyle gelmektedir

örnek: A.F.S.CAM AYNA MOBİAL.İM.SAN.TİC.LTŞTİ. 04-2011-04-2011 KDV1 TAHAKKUK

örnek: ALİ YAVUZ GÜNAYDIN 04-2011-04-2011 KDV1 TAHAKKUK

Olması gereken : A.F.S.CAM AYNA MOBİAL.İM.SAN.TİC.LTŞTİ.

Olması gereken : ALİ YAVUZ GÜNAYDIN

Kusuru bakmayın. Makroyu buna göre nasıl düzenleriz

 

[leumruk]

Merhaba,
Dosyayı ben mi indiremiyorum, yoksa ekte bir sorun mu var?

Düzeltme: Orbit indirme programından kaynaklanıyormuş...

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub Dosya_İsimleri()
    Dim Klasör As Object, Dosya_Yolu As String, Dosya As Object, Bul As Integer
 
    Set Klasör = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen Klasör Seçiniz !", 1)
    If Klasör Is Nothing Then Exit Sub
 
    Dosya_Yolu = Klasör.Self.Path & "\"
 
    If CreateObject("Scripting.FileSystemObject").GetFolder(Dosya_Yolu).Files.Count = 0 Then Exit Sub
 
    Range("B2:B" & Rows.Count).ClearContents
 
    Satır = 2
 
    For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder(Dosya_Yolu).Files
        If InStr(1, Dosya.Name, "-") > 0 Then
            Bul = InStr(1, Dosya.Name, "-")
            Cells(Satır, 2) = Left(Dosya.Name, Bul - 3)
            Satır = Satır + 1
        Else
            Cells(Satır, 2) = Replace(Dosya.Name, ".pdf", "")
            Satır = Satır + 1
        End If
    Next
 
    Set Klasör = Nothing
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[drummers]

yanlış bilgi vermişim

Benden kaynaklı bir hata var. Kusurma bakmayım.

Listelediğim klasörü yanlış seçmişim. Listelenen verilerim aynen söyle gelmektedir

örnek: A.F.S.CAM AYNA MOBİAL.İM.SAN.TİC.LTŞTİ. 04-2011-04-2011 KDV1 TAHAKKUK

örnek: ALİ YAVUZ GÜNAYDIN 04-2011-04-2011 KDV1 TAHAKKUK

Olması gereken : A.F.S.CAM AYNA MOBİAL.İM.SAN.TİC.LTŞTİ.

Olması gereken : ALİ YAVUZ GÜNAYDIN

Kusuru bakmayın. Makroyu buna göre nasıl düzenleriz

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki kodu güncelledim. İncelermisiniz.

 

[drummers]

Selamlar,

Üstteki mesajımdaki kodu güncelledim. İncelermisiniz.

Teşekkürler. Çok makbule geçti