C:\Resimler dosyasından resimlerin isimlerini almak

[Halit TÜRK]

Merhabalar
C:\Resimler dosyasından resimlerin isimlerini excel sayfasına almak mümkünmüdür. İyi Çalışmalar...

 

[Haluk]

Sub Test()
    MyPath = "C:\Resimler"
    MyFile = Dir(MyPath & Application.PathSeparator & "*.jpg", vbDirectory)
    Do While MyFile <> ""
        i = i + 1
        Cells(i, 1) = MyFile
        MyFile = Dir
    Loop
End Sub

 

[Halit TÜRK]

Özür dilerim bu konu işlenmiş... Uyguladım..
http://www.excel.web.tr/showthread.php?t=53312

Haluk bey şimdi gördüm yine de teşekkürler..

 

[Orion1]

jpg uzantılı dosyaların A sütununa yalnızca adlarını yazar.

Sub resimal()
Dim yol, dosya As String, sat As Long
yol = "C:\Resimler\"
dosya = Dir(yol & "*.jpg")
Range("A1:A65536").ClearContents
Do While dosya <> ""
    sat = sat + 1
    Cells(sat, "A").Value = Left(dosya, Len(dosya) - 4)
    dosya = Dir
Loop
MsgBox "İşlem tamam"
    
End Sub

 

[Halit TÜRK]

Bilgi..

Haluk Bey sizin kod hata verdi..

Evren Bey sizin kodlarınız sonuç veriyor..

 

[Haluk]

Sağlık olsun...

 

[uzmanamele]

Bilgi..

Haluk Bey sizin kod hata verdi..

Evren Bey sizin kodlarınız sonuç veriyor..

merhaba
aksine syn Haluk beyin kodları çalışdı, syn Evren beyin kodu sunuç vermedi

 

[Orion1]

merhaba
aksine syn Haluk beyin kodları çalışdı, syn Evren beyin kodu sunuç vermedi

Sağlık olsun.

 

[Halit TÜRK]

merhaba
aksine syn Haluk beyin kodları çalışdı, syn Evren beyin kodu sunuç vermedi

Haklı olabilirsiniz ama benim dosyada çalışmadı.. MyPath burada hata veriyor..
Variable not defined hatası veriyor..

 

[uzmanamele]

merhaba
syn Evren Gizlen,
kodda dosya yolunu yazarken baskı hatası yapmışım (yanlış harf)
kod gayet güzel çalışıyor, eline sağlık.

 

[Haluk]

Haklı olabilirsiniz ama benim dosyada çalışmadı.. MyPath burada hata veriyor..
Variable not defined hatası veriyor..

Hata, benim kodumdan dolayı değil.... sizin orjinal kodunuzda ilk satırda "Option Explicit" ifadesi olmasından kaynaklanıyor.

O satırı silin.... kod hatasız çalışır.



.

 

[Halit TÜRK]

Hata, benim kodumdan dolayı değil.... sizin orjinal kodunuzda ilk satırda "Option Explicit" ifadesi olmasından kaynaklanıyor.

O satırı silin.... kod hatasız çalışır.



.

Haluk bey haklısınız düzeldi. Option Explicit her yeni makro açılırken otomatik geliyor sebebi nedir acaba. Birde hem jpg hem de gif olarak almak istersek nasıl bir değişiklik gerekiyor.. Teşekkürler..

 

[Haluk]

VBE editöründe Tools >> Options menüsünü tıklayın.

"Editor" sekmesinde "Require variable declaration" kısmındaki onay işaretini kaldırın, pencereyi onaylayıp, kapatın.


.

 

[Halit TÜRK]

Teşekkürler. aynı anda .gif uzattıları da aldırmak için nasıl bir değişiklik gerekiyor.

 

[Ayhan Ercan]

Resimler klasöründeki tüm dosyalar için

dosya = Dir(yol & "*.*") şeklinde denermisiniz...

 

[Haluk]

Sub Test2()
    MyExt = Array("*.jpg", "*.gif")
    MyPath = "C:\Resimler"
    For j = LBound(MyExt) To UBound(MyExt)
        MyFile = Dir(MyPath & Application.PathSeparator & MyExt(j), vbDirectory)
        Do While MyFile <> ""
            i = i + 1
            Cells(i, 1) = MyFile
            MyFile = Dir
        Loop
    Next
End Sub

 

[Orion1]

Sub resimal()
Dim yol, dosya As String, sat As Long, dosya2 As String
yol = "C:\Evren\Resimler\"
dosya = Dir(yol & "*.jpg")
Range("A1:A65536").ClearContents
Do While dosya <> ""
    sat = sat + 1
    Cells(sat, "A").Value = Left(dosya, Len(dosya) - 4)
    dosya = Dir
Loop
dosya2 = Dir(yol & "*.gif")
Do While dosya2 <> ""
    sat = sat + 1
    Cells(sat, "A").Value = Left(dosya2, Len(dosya2) - 4)
    dosya2 = Dir
Loop
MsgBox "İşlem tamam"
End Sub

 

[Halit TÜRK]

Çok Çok Teşekkür ederim Haluk bey, Evren bey, Ayhan bey ve emeği geçen arkadaşlara..

Haluk bey affınıza sığınarak koda ilave yaptım. İşlem uzun sürüyordu... Teşekkürler...

Sub Test2()
Application.ScreenUpdating = False
MyExt = Array("*.jpg", "*.gif")
MyPath = "C:\Resimler"
For j = LBound(MyExt) To UBound(MyExt)
myfile = Dir(MyPath & Application.PathSeparator & MyExt(j), vbDirectory)
Do While myfile <> ""
i = i + 1
Cells(i, 3) = myfile
Cells(i, 3).Value = Left(myfile, Len(myfile) - 4)
myfile = Dir
Loop
Next
Application.ScreenUpdating = True
End Sub

 

[Orion1]

Haluk hocam bir soruda ben sorabilirmiyim.
İlk verdiğiniz kodlarda klasör arasındaki separöter için Application.separator kullanmışsınız.
Fakat C:\ Kök dizinindeki \ seperatörünü \ karakterini sabit olarak kullanmışsınız.
Kök dizinini belirleyen separoterler sabit kalıp değişmiyorlarmı?
Kök dizinden sonraki separotor hep \ karakterimi oluyor?
Teşekkür ederim.

 

[Haluk]

Asl&#305;nda, i&#351;in do&#287;rusu birincisini de "Application.PathSeparator" olarak yapmak.

Bazen &#252;&#351;eniyorum i&#351;te...


.