View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Steve Yandl Steve Yandl is offline
external usenet poster
 
Posts: 284
Default Get Dimensions of Image File Outside Excel

The article in this link is what I used to get started. I suspect that your
issue is rooted in changes made in Vista. Perhaps something in the article
will help you search for updated information for a Vista system.

http://www.microsoft.com/technet/scr....mspx?mfr=true

Steve


"Lazzaroni" wrote in message
...
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