CODEWITHSUNDEEP
imagevbams-access
user3791372
user3791372

Reputation: 4695

Microsoft Access VBA - determining image dimensions

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.

Upvotes: 1

Views: 6522

Answers (3)

ChrisB
ChrisB

Reputation: 3225

You can also accomplish this with a class, which lets you use code like this:

targetImage.PixelWidth
targetImage.PixelHeight
  1. Create a new Class Module and name it ImageDimensions.
  2. 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

Upvotes: 2

Johnny Bones
Johnny Bones

Reputation: 8414

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

Upvotes: 4

HarveyFrench
HarveyFrench

Reputation: 4578

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

Upvotes: 4

Related Questions