dosya özellikleri

[karakayalı]

klasör içeresinde bulunan dosyalarımın görünüm kısmında ayrıntılar dediğimde...adı, boyut tür vs. gelmektedir...ben bunları excel e atmak istiyorum...yardımlarınız için şimdidine teşekkürler...

 

[halit3]

bu kodu boş bir excel sayfasında deneyiniz.

Sub ozellikleri()
Range("A1:B60").ClearContents
GetOpenFilename = Application.GetOpenFilename
Worksheets(ActiveSheet.Name).Cells(1, 1).Value = GetOpenFilename
If Worksheets(ActiveSheet.Name).Cells(1, 1).Value <> "" Then
alan1 = Len(Worksheets(ActiveSheet.Name).Cells(1, 1).Value)
For i = 1 To alan1 - 1
If Mid((Worksheets(ActiveSheet.Name).Cells(1, 1).Value), alan1 - i, 1) = "\" Then
sat1 = sat1 + 1
End If
If sat1 = 0 Then
On Error Resume Next
Worksheets(ActiveSheet.Name).Cells(1, 2).Value = Right((Worksheets(ActiveSheet.Name).Cells(1, 1).Value), i + 1)
End If
Next i
alan2 = Worksheets(ActiveSheet.Name).Cells(1, 1).Value
alan3 = Len(Worksheets(ActiveSheet.Name).Cells(1, 2).Value)
Worksheets(ActiveSheet.Name).Cells(1, 1).Value = Mid(alan2, 1, alan1 - alan3)
klasöradı = Worksheets(ActiveSheet.Name).Cells(1, 1).Value
dosyaadı = Worksheets(ActiveSheet.Name).Cells(1, 2).Value
Set Dosya = CreateObject("Shell.Application").Namespace(klasöradı).ParseName(dosyaadı)
For a = 1 To 60
If WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("A2:A65000")) <= 42 Then
Cells(a + 1, "a") = CreateObject("Shell.Application").Namespace(klasöradı).GetDetailsOf(, a)
End If
Cells(a + 1, "b") = CreateObject("Shell.Application").Namespace(klasöradı).GetDetailsOf(Dosya, a)
Next
End If
End Sub

 

[karakayalı]

syn halit3 kod hata verdi...diğelim ki resimlerim klsöründe .jpg uzantılı dosyalarım var...bunun özelleiklerini nası excele atabiliriz..adı, boyut tür vs.

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

Sub dosyaozellikleri()
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
For Each dosyaadi In CreateObject("Scripting.FileSystemObject").GetFolder(klasoryolu).Files
c = c + 1
Set dosya = CreateObject("Shell.Application").Namespace(klasor).ParseName(dosyaadi.Name)
Cells(1, c + 1) = dosyaadi.Name
For a = 1 To 40
If c = 1 Then Cells(a + 1, "a") = CreateObject("Shell.Application").Namespace(klasor).GetDetailsOf("", a)
Cells(a + 1, c + 1) = CreateObject("Shell.Application").Namespace(klasor).GetDetailsOf(dosya, a)
Next
Next
End Sub

 

[karakayalı]

syn Levent Menteşoğlu emeğiniz için teşekkürler..

 

[mf.murat]

Dosya Listeleme

ARkadaşlar bu özellikleri Excel sayfasında yan yana nasıl yazdırırım.
Seçtiğim klasördeki birden fazla dosya özelliğinin alt alta liste halinde listelenmesini istiyorum.

YArdımlarınız bekliyorum lütfen

 

[baydeniro]

Sayın Levent Menteşoğlu çok güzel bir kod, çok çok teşekkür ederim.
Bu kodu; bilgilerin yazılacağı dosyayı kodun için yazmak yani browser'dan seçmeden kaydetmek için koıdu nasıl revise etmek gerekir acaba ?

 

[Gorarr]

Levent hocam, dosya isimlerini "A" sütununa aşağı doğru sıralayıp, özellikleride yan sütunlara doğru çıkması için nasıl bir değişiklik gerekli. Yardımcı olabilirmisiniz teşekkürler.

 

[Levent Menteşoğlu]

Levent hocam, dosya isimlerini "A" sütununa aşağı doğru sıralayıp, özellikleride yan sütunlara doğru çıkması için nasıl bir değişiklik gerekli. Yardımcı olabilirmisiniz teşekkürler.

Aşağıdaki gibi deneyin.

Sub dosyaozellikleri()
On Error Resume Next
Cells.ClearContents
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
For Each dosyaadi In CreateObject("Scripting.FileSystemObject").GetFolder(klasoryolu).Files
c = c + 1
Set dosya = CreateObject("Shell.Application").Namespace(klasor).ParseName(dosyaadi.Name)
Cells(c + 1, "a") = dosyaadi.Name
For a = 1 To 40
Cells(1, a + 1) = CreateObject("Shell.Application").Namespace(klasor).GetDetailsOf("", a)
Cells(c + 1, a + 1) = CreateObject("Shell.Application").Namespace(klasor).GetDetailsOf(dosya, a)
Next
Next
End Sub

 

[Levent Menteşoğlu]

Sayın Levent Menteşoğlu çok güzel bir kod, çok çok teşekkür ederim.
Bu kodu; bilgilerin yazılacağı dosyayı kodun için yazmak yani browser'dan seçmeden kaydetmek için koıdu nasıl revise etmek gerekir acaba ?

Aşağıdaki gibi bir mantık kullanabilirsiniz.

Sub dosyaozellikleri()
Set nesne = CreateObject("shell.application")
Set klasor = nesne.Namespace("E:\26")
Set dosya = klasor.ParseName("deneme.xls")
For a = 1 To 40
Cells(a + 1, "a") = nesne.Namespace(klasor).GetDetailsOf("", a)
Cells(a + 1, "b") = klasor.GetDetailsOf(dosya, a)
Next
End Sub