Klasör İçinde Bulunan Sütun Verilerin Özellikleri Excele Aktarmak.

[yasin85]

Herkese Merhaba,

Aşağıdaki resimde kırmızı renkle işaretlediğim sütunların altta çıkan verilerini excele almam gerekli boyut ölçüleri hariç ala biliyoruz fakat oda işimizi görmüyor bize özellikle Ad ve Boyutlar kısmı gereklidir.
Bu konuda yardımcı ola bilirmisiniz.

 

[ÖmerFaruk]

İnceleyebilirsiniz
https://www.excel.web.tr/threads/resim-verilerini-alma-width-x-height-size.155844/post-848381

 

[yasin85]

Sn. @ÖmerFaruk Bey,
Verdiğiniz linkten yola çıkarak istediğim sonuca ulaştım teşekkürler.

 

[yasin85]

Sn. @halit3 bey'in yaptığı kod işe yarıyor emeğinize sağlık.

Yan yana ve Alt alta secenekleri mevcuttur.
https://www.excel.web.tr/threads/dosya-oezellikleri-listeleme.89414/

Excel İndir

Sub dosyaozellikleri()
sat = 1
Cells.Hyperlinks.Delete
On Error Resume Next
Set Klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçin !", &H100)
klasoryolu = Klasor.Items.Item.Path
If klasoryolu = "" Then Exit Sub
Cells(1, 1) = "Dosya adı"
For a = 1 To 48
Cells(1, a + 1) = CreateObject("Shell.Application").Namespace(Klasor).GetDetailsOf("", a)
Next
sat = sat + 1
For Each dosyaadi In CreateObject("Scripting.FileSystemObject").GetFolder(klasoryolu).Files
c = c + 1
Set Dosya = CreateObject("Shell.Application").Namespace(Klasor).ParseName(dosyaadi.Name)
Cells(sat, 1) = dosyaadi.Name
Cells(sat, 1).Hyperlinks.Add Anchor:=Cells(sat, 1), Address:=Klasor & "\" & dosyaadi.Name, TextToDisplay:=dosyaadi.Name
For a = 1 To 48
Cells(sat, a + 1) = CreateObject("Shell.Application").Namespace(Klasor).GetDetailsOf(Dosya, a)
Next
sat = sat + 1
Next
MsgBox "işlem tamam"
End Sub

 

[ÖmerFaruk]

Çok hoş, eline emeğine sağlık