dosya adını excel e yazdırmak

[karakayalı]

jpeg uzantılı 1000'lerce resimlerim var ben bunların dosya adını excele aktarmak istiyorunm...

örneğin dosya adı ali.jpeg
hasan.jpeg

excele bunların hasan
ali
...... olarak aktarılmasını istiyorum..koülay gelsin

 

[uzmanamele]

merhaba
kod syn Haluk'a aittir

Sub Test()
Dim i As Integer
Dim Yol As String
Yol = "C:\Resimlerim" & Application.PathSeparator & Range("A1")
ChDir (Yol)
ResimDosya = Dir("*.jpg")
Range("B:B").ClearContents
i = 2
While ResimDosya <> ""
Cells(i, 2) = ResimDosya
i = i + 1
ResimDosya = Dir
Wend
Range("C2") = "Toplam " & i - 2 & " adet resim var."
End Sub

 

[karakayalı]

sayın uzmanamele, 5. satır hata kodu verdi..

 

[uzmanamele]

merhaba
hata vermemesi lazım.
ankarada kar yağıyor, yollar çamurlu olduğu için ilerleyememiştir

klasör yolunu kontrol ediniz.

 

[karakayalı]

merhaba,
kar dindi (Bahar geldi )hala aynı hatayı veriyor...

 

[janveljan]

Farklı bir uygulama ama işinizi görebilir. Önce fihrist oluştur deyin, klasör yolunu seçin daha sonra da B sütununda dolaşın resimleri gösterecektir. Uzantıları mutlaka silmek gerekiyorsa bul değiştirle halledersiniz artık. (İsim değiştirme kısmı o dosyaya B sütununda verdiğiniz yeni ismi değiştirmek için)

 

[karakayalı]

syn janveljan, teşekkürler...

 

[yasin85]

merhaba
kod syn haluk'a aittir

sub test()
dim i as ınteger
dim yol as string
yol = "c:\resimlerim" & application.pathseparator & range("a1")
chdir (yol)
resimdosya = dir("*.jpg")
range("b:b").clearcontents
i = 2
while resimdosya <> ""
cells(i, 2) = resimdosya
i = i + 1
resimdosya = dir
wend
range("c2") = "toplam " & i - 2 & " adet resim var."
end sub

helal olsun sana süper birşey yazmışşsın 2 günlük işimi 1 saatte halletim sayende çok teşekkür ederim