View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Lazzaroni Lazzaroni is offline
external usenet poster
 
Posts: 55
Default Get Dimensions of Image File Outside Excel

Steve:

That's what I was looking for. The FileSystemObject and the GetDetailsOf
method.

I had to change the GetDetailsOf method constant from 26 to 31 to return the
image dimensions. 26 returned nothing. I checked the FSO documentation but
could not find anything on this. Perhaps it is because I am using Windows
Vista.

Using GetDetailsOf constant 31 returns the image dimensions, but enclosed in
mystery characters that appear as question marks on my computer. That's the
reason for the additional string manipulation.

Perhaps someone can explain the change in the constant, or improve upon my
code.

Thank you for your help.

Function GetImageDimensions(ByVal strPath As String, Optional ByRef lngWidth
As Long, Optional ByRef lngHeight As Long) As Boolean

Dim objFSO As New FileSystemObject
Dim objShell As Object
Dim objFolder As Object
Dim varFileName As Variant
Dim strDimensions() As String

ReDim strDimensions(0)

Const filePropName = 0
Const filePropType = 2
Const filePropDimensions = 31 '26?

If objFSO.FileExists(strPath) Then

GetImageDimensions = True

Set objShell = CreateObject("Shell.Application")
Set objFolder =
objShell.Namespace(objFSO.GetParentFolderName(strP ath))

For Each varFileName In objFolder.Items

If objFolder.GetDetailsOf(varFileName, filePropName) =
objFSO.GetFileName(strPath) Then
strDimensions(0) = objFolder.GetDetailsOf(varFileName,
filePropDimensions)
If InStr(strDimensions(0), " x ") 0 Then
strDimensions = Split(strDimensions(0), "x")
lngWidth = CLng(Mid(Trim(strDimensions(0)), 2))
lngHeight = CLng(Mid(Trim(strDimensions(1)), 1,
Len(Trim(strDimensions(1))) - 1))
Exit For
Debug.Print lngWidth
Debug.Print lngHeight
End If
End If
Next

End If

Set objFSO = Nothing
Set objFolder = Nothing
Set objShell = Nothing

End Function