Resim özelliklerini(boyutlarını) almak

[inFiesta]

Merhabalar;

Vba ile resim dosyasının piksel olarak karşılığını almak istiyorum. Windowsta klasör listelerken belirtilen "1024 x 768" gibi ifade edilen özellikten bahsediyorum. DateLastModified, DateCreated, Attributes gibi özellikleri alabiliyorum, fakat resim boyutlarını almayı başaramadım bir türlü.

2000'e yakın proje taramasının toplam uzunluğunu hesaplamaya çalışıyorum. Birisini almayı başarırsam kodu genele uyarlarım sanırım.

saygılarımla

 

[Haluk]

Sub Test()
    '
    '   Raider ® - Haziran 2006
    '
    Dim objShell As Object, objFolder As Object, objFolderItem As Object
    Dim strFolder As Variant, strFileName As Variant
 
    strFolder = "D:\Arsiv"
    strFileName = "Ataturk.jpg"
 
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(strFolder)
    Set objFolderItem = objFolder.ParseName(strFileName)
    MsgBox objFolder.GetDetailsOf(objFolderItem, 26)
 
    Set objFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing
End Sub

Not: Konunun ana fikri aşağıdaki linktedir.

http://www.excel.web.tr/showthread.php?t=7194

.

 

[inFiesta]

Çok teşekkür ediyorum Haluk Bey,
Kod istediğim gibi çalışıyor. Programlama konusunda biraz acemiyim, ama sanırım bir döngü yazabilirim bunun için.

 

[Haluk]

Yukarıdaki linkte verilen kodu, buraya uyarlarsak;

Sub Test2()
    Dim objShell As Object, objFolder As Object
    Dim ArrItems
    Dim i As Long, j As Long
    
    strFolder = "D:\Arsiv"
    
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(strFolder)
    
    ArrItems = Array(0, 1, 2, 26)
    
    For j = 0 To 3
        Cells(1, j + 1) = objFolder.GetDetailsOf(objFolder.Items, ArrItems(j))
    Next
    
    Rows(1).Font.Bold = True
    
    i = 1
    
    For Each strFileName In objFolder.Items
        i = i + 1
        For j = 0 To 3
            Cells(i, j + 1) = objFolder.GetDetailsOf(strFileName, ArrItems(j))
        Next
    Next
    
    Columns("A:M").AutoFit
End Sub

 

[inFiesta]

Haluk Bey tam olarak istediğim şeye uyarlamışsınız. Path'i değiştirmek dışında ekstradan herhangi bir şey yapmama gerek bile kalmadı. Diğer Extended dosya özelliklerini de öğrenmiş olduk sayenizde. Farklı programlar için sık kullanılabilecek bir bilgi. İlginiz için çok teşekkür ediyorum.