Question

我有一个Access数据库，它有一个文件名字段，以及图像的宽度和高度字段。我没有手动填充宽度和高度，而是尝试仅从文件名中读取高度和宽度（完整文件路径），然后插入到记录中。

在大多数语言中，维度的读取相当简单，但对于Access VBA来说却找不到多少。我所能找到的只是Excel，它假定图像已作为对象存在于电子表格中。

Answer 1

尝试使用Google搜索“使用vba读取图像文件尺寸”

例如 https://social.msdn.microsoft.com/Forums/office/en-US/5f375529-a002-4312-a54b-b70d6d3eb6ae/how-to-retrieve-image-dimensions-using-vba-?forum=accessdev

例如

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

您可以从消息框中显示的字符串中提取所需内容

Answer 2

你可以这样做：

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

该消息框应该为您提供符合＆＃34; 300 X 500＆＃34; （或长度X宽度）。如果您需要个别尺寸，则需要使用

之类的东西

FileLen = CInt(Trim(Mid(objFile.ExtendedProperty, 2, InStr(objFile.ExtendedProperty, "X") - 1)))

和

FileWid = CInt(Trim(Mid(objFile.ExtendedProperty, InStr(objFile.ExtendedProperty, "X") + 2, Len(objFile.ExtendedProperty))))

Answer 3

您还可以使用类来完成此操作，该类允许您使用以下代码：

targetImage.PixelWidth
targetImage.PixelHeight

创建一个新的类模块，并将其命名为ImageDimensions。
将以下代码粘贴到该类模块中：

课程模块代码

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

使用示例

将此代码放在常规代码模块（不是类模块）中：

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

Microsoft Access VBA - 确定图像尺寸

3 个答案:

课程模块代码

使用示例