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(strPath))
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
