CODEWITHSUNDEEP
vbaexcelms-word
Marco Faulhaber
Marco Faulhaber

Reputation: 23

Read DPI of Image-File

Good morning,

I want to crop pictures through VBA-Code. Due to the reason that images can occur in two different resolutions (96x96 DPI and 300x300 DPI) I need to know what res. the image-file has to crop it correctly. The file format of those images is .tif.

On the internet I found following code which uses a FSO to get the image file attributes:

Dim fso As New FileSystemObject
Debug.Print fso.GetFile("C:\Users\...\Downloads\75.tif").Attributes '<-- 32

This is where it gets complicated. I can only see how many attributes an image has but cant get further into them. There is more code here but this one only works for jpg format.

Can anyone help me?

Upvotes: 0

Views: 2146

Answers (2)

Marco Faulhaber
Marco Faulhaber

Reputation: 23

thanks for answering. Your code is nearly the same one I am using currently. I just need one resolution so I did not write a second value. Furthermore I do some string adjustments because it returns

"?96 dpi"

So I am able to return the DPI value with one command. Here's the code I am using. I hope this helps other people as well!

Public Function getDPI() As Integer

    Dim objShell
    Dim objFolder
'   Dim i

    Set objShell = CreateObject("shell.application")
    Set objFolder = objShell.NameSpace("edit path here") ' <-- ToDo

    If (Not objFolder Is Nothing) Then
        Dim objFolderItem

        Set objFolderItem = objFolder.ParseName("edit filename here") ' <-- ToDo

        If (Not objFolderItem Is Nothing) Then
            Dim objInfo
'            For i = 1 To 288
               getDPI = Trim(Mid(objFolder.GetDetailsOf(objFolderItem, 161), 2, 3)) ' <--161 represents the horizontal resolution
'            Next
        End If

        Set objFolderItem = Nothing
    End If

    Set objFolder = Nothing
    Set objShell = Nothing

End Function

Upvotes: 0

Ryan Wildry
Ryan Wildry

Reputation: 5677

Something like this should work.

You can use the Shell.Application object to retrieve file details. The DPI is spread out over two properties. The Horizontal Resolution and the Vertical Resolution.

Here's a brief example that will iterate a folder and give you the DPI for each image.

Sub getResolution()
    Const HorizontalRes As Integer = 161
    Const VerticalRes As Integer = 163

    Dim i       As Long
    Dim wsh     As Object: Set wsh = CreateObject("Shell.Application")
    Dim fileObj As Object
    Dim foldObj As Object
    Dim Folder  As Object
    Dim vRes    As String
    Dim hRes    As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select the Folder..."
        .AllowMultiSelect = False
        If .Show Then
            Set foldObj = wsh.Namespace(.SelectedItems(1))

            For Each fileObj In foldObj.Items
                vRes = foldObj.GetDetailsOf(fileObj, HorizontalRes)
                hRes = foldObj.GetDetailsOf(fileObj, VerticalRes)

                MsgBox fileObj.Name & vbCrLf & _
                       "Horizontal Resolution: " & hRes & vbCrLf & _
                       "Vertical Resolution: " & vRes
            Next
        End If

    End With

End Sub

Upvotes: 2

Related Questions