Microsoft Access VBA - determining image dimensions - image

Question

I have an Access database which has a filename field, along with width and height fields for an image. Instead of populating the width and height manually, I'm trying to read the height and width from the filename alone (full file path) and then insert into a record.
The reading of dimensions is fairly trivial in most languages, but can't find much for Access VBA. All I can find is for Excel which assumes the image is already in the spreadsheet as an object.

Answer 1

Just try googling "Use vba to read image file dimensions"
eg
https://social.msdn.microsoft.com/Forums/office/en-US/5f375529-a002-4312-a54b-b70d6d3eb6ae/how-to-retrieve-image-dimensions-using-vba-?forum=accessdev
for example
Dim objShell As Object
Dim objFolder As Object
Dim objFile As Object
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace("C:\Documents and Settings\Administrator\Desktop")
Set objFile = objFolder.ParseName("file_name.bmp")
MsgBox objFile.ExtendedProperty("Dimensions")
You can extract what you need from the string displayed in the message box

Answer 2

You can do this:
Dim objShell As Object
Dim objFolder As Object
Dim objFile As Object
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace("C:\Documents and Settings\Administrator\Desktop")
Set objFile = objFolder.ParseName("file_name.bmp")
MsgBox objFile.ExtendedProperty("Dimensions")
That messagebox should give you something along the lines of "300 X 500" (or whatever the Length X Width is). If you need the individual dimensions, you'll need to use something like
FileLen = CInt(Trim(Mid(objFile.ExtendedProperty, 2, InStr(objFile.ExtendedProperty, "X") - 1)))
and
FileWid = CInt(Trim(Mid(objFile.ExtendedProperty, InStr(objFile.ExtendedProperty, "X") + 2, Len(objFile.ExtendedProperty))))

Answer 3

You can also accomplish this with a class, which lets you use code like this:
targetImage.PixelWidth
targetImage.PixelHeight
Create a new Class Module and name it ImageDimensions.
Paste the following code into that class module:
Class Module Code
Option Explicit
Private pPixelWidth As Long
Private pPixelHeight As Long
Private pImageFullPath As String
Public Property Get ImageFullPath() As String
ImageFullPath = pImageFullPath
End Property
Public Property Let ImageFullPath(fullPath As String)
pImageFullPath = fullPath
Dim dimensionsText As String
dimensionsText = GetImageDimensions(fullPath)
pPixelWidth = Left$(dimensionsText, InStr(dimensionsText, ",") - 1)
pPixelHeight = Mid$(dimensionsText, InStr(dimensionsText, ",") + 1)
End Property
Public Property Get PixelWidth() As Long
PixelWidth = pPixelWidth
End Property
Private Property Let PixelWidth(value As Long)
pPixelWidth = value
End Property
Public Property Get PixelHeight() As Long
PixelHeight = pPixelHeight
End Property
Private Property Let PixelHeight(value As Long)
pPixelHeight = value
End Property
Private Function GetImageDimensions(ByVal fullPath As String)
Dim fileName As String
Dim fileFolder As String
fileName = FilenameFromPath(fullPath)
fileFolder = FolderFromFilePath(fullPath)
Dim objShell As Object
Set objShell = CreateObject("Shell.Application")
Dim targetFolder As Object
Set targetFolder = objShell.Namespace(fileFolder & vbNullString)
Const IMAGE_DIMENSIONS As Long = 31
Dim dimensionsPrep As String
dimensionsPrep = targetFolder.GetDetailsOf( _
targetFolder.Items.Item(fileName & vbNullString), _
IMAGE_DIMENSIONS)
dimensionsPrep = Replace(dimensionsPrep, " x ", ",")
dimensionsPrep = Mid$(dimensionsPrep, 2, Len(dimensionsPrep) - 2)
GetImageDimensions = dimensionsPrep
End Function
Private Function FolderFromFilePath(ByVal filePath As String) As String
Dim filesystem As Object
Set filesystem = CreateObject("Scripting.FileSystemObject")
FolderFromFilePath = filesystem.GetParentFolderName(filePath) & "\"
End Function
Private Function FilenameFromPath(ByVal filePathAndName As String) As String
Dim pathLength As Long
Dim iString As String
pathLength = Len(filePathAndName)
iString = vbNullString
Dim iCount As Long
For iCount = pathLength To 1 Step -1
If Mid$(filePathAndName, iCount, 1) = Application.PathSeparator Then
FilenameFromPath = iString
Exit Function
End If
iString = Mid$(filePathAndName, iCount, 1) & iString
Next iCount
FilenameFromPath = filePathAndName
End Function
Example Usage
Put this code in a regular code module (not a class module):
Sub ExampleImageDimensions()
Dim targetImage As ImageDimensions
Set targetImage = New ImageDimensions
targetImage = "C:\Users\ChrisB\Downloads\Screenshot.jpg"
Debug.Print targetImage.PixelHeight
Debug.Print targetImage.PixelWidth
End Sub