Tuesday, January 13, 2015

Excel VBA get extended property for Image file


There are 287 extended property, to get Image info you can use following code:

Option Explicit

Sub GetImageInfo()

Dim i As Integer, SourceFldr

Dim c As Range, rng As Range

Dim sFile As Variant

Dim oWSHShell As Object

Dim fldr As FileDialog

Set fldr = Application.FileDialog(msoFileDialogFolderPicker)

Set oWSHShell = CreateObject("WScript.Shell")

With fldr

    .Title = "Select a Source Folder"

    .AllowMultiSelect = False

    .InitialFileName = oWSHShell.SpecialFolders("Desktop")

    If .Show <> -1 Then GoTo NextCode

    SourceFldr = .SelectedItems(1)


End With

Dim oShell: Set oShell = CreateObject("Shell.Application")

Dim oDir:   Set oDir = oShell.Namespace(SourceFldr)

i = 3


For Each sFile In oDir.Items

    Cells(i, 1).Value = oDir.GetDetailsOf(sFile, 0)   'File Name

    Cells(i, 2).Value = oDir.GetDetailsOf(sFile, 1)   'File Size

    Cells(i, 3).Value = oDir.GetDetailsOf(sFile, 2)   'File Type

    Cells(i, 4).Value = oDir.GetDetailsOf(sFile, 5)   'Date Created

    Cells(i, 5).Value = oDir.GetDetailsOf(sFile, 12)  'Date Taken

    Cells(i, 6).Value = oDir.GetDetailsOf(sFile, 31)  'Dimensions

    Cells(i, 7).Value = oDir.GetDetailsOf(sFile, 160) 'Bit Depth

    Cells(i, 8).Value = oDir.GetDetailsOf(sFile, 164) 'Height

    Cells(i, 9).Value = oDir.GetDetailsOf(sFile, 162) 'Width

    Cells(i, 10).Value = oDir.GetDetailsOf(sFile, 161)'Horizontal Resolution

    Cells(i, 11).Value = oDir.GetDetailsOf(sFile, 163)'Vertical Resolution

i = i + 1


    Set oDir = Nothing

    Set oShell = Nothing


MsgBox "Done"

End Sub


No comments:

Post a Comment