Windowsのシェルオブジェクトを使用して、画像ファイルの幅と、高さを取得します。
サンプルプログラムでは、フォルダを指定して、そのフォルダの中にある画像ファイルを検索して幅と高さを取得します。結果を指定したシートに追加していきます。
【サンプルプログラム】
' フォルダにある画像ファイルからサイズを取得する
Sub GetSizeOfImgFileInFolder(ByVal path As String)
Dim fso As FileSystemObject
Set fso = New FileSystemObject
' ファイルを検索
FindImgFileList fso, path, Sheets("Sheet2"), "A1"
End Sub
' フォルダを検索
Sub FindImgFileList(fso As FileSystemObject, parent_path As Variant, ws As Worksheet, start_pos As String)
Dim path As Variant
Dim width As Long
Dim height As Long
Dim result As Boolean
Dim last_rgn As Range
' フォルダ内のサブフォルダを検索 (サブフォルダが不要なら削除)
For Each path In fso.GetFolder(parent_path).SubFolders
Call FindImgFileList(fso, path, ws, start_pos) ' 再帰検索
Next
' フォルダ内のファイルを検索
For Each path In fso.GetFolder(parent_path).Files
' 画像の幅と、高さを取得します
result = GetImageSize(path, width, height)
If result = True Then
Set last_rgn = GetBlankNextRange(ws, start_pos)
' データの追加
If last_rgn.Row <= 1 Then ' 先頭行の場合
' タイトル
last_rgn = "No."
last_rgn.Offset(0, 1) = "ファイル名"
last_rgn.Offset(0, 2) = "幅"
last_rgn.Offset(0, 3) = "高さ"
' 一件目をタイトルの下に追加する
Set last_rgn = last_rgn.Offset(1, 0)
' 一件目をなのでNo.に 1 をセットする
last_rgn = 1
Else
' 2行目以降の場合は、前の数値に+1
last_rgn = last_rgn.Offset(-1, 0) + 1
End If
last_rgn.Offset(0, 1) = path
last_rgn.Offset(0, 2) = width
last_rgn.Offset(0, 3) = height
End If
Next
End Sub【関数化】
' ------------------------------------------------------------
' 説明：画像ファイルのパスを指定して、画像の幅と、高さを取得します
' 引数：1:画像ファイルのパス
' 2:取得した画像の幅 (出力)
' 3:取得した画像の高さ (出力)
' 戻値：画像の幅と高さが取得できた場合はTrue、取得できなかった場合(画像ファイル以外の場合も)はFalse
' ------------------------------------------------------------
Function GetImageSize(in_filename As Variant, out_width As Long, out_height As Long) As Boolean
Dim objShell As Shell
Set objShell = New Shell ' Shell オブジェクトの作成
Dim fso As FileSystemObject
Set fso = New FileSystemObject ' オブジェクトの作成
Dim objFolder As Folder3
Dim objFolderItem As FolderItem2
Dim result As Variant
out_width = -1
out_height = -1
Set objFolder = objShell.Namespace(fso.GetParentFolderName(in_filename))
If (Not objFolder Is Nothing) Then
Set objFolderItem = objFolder.ParseName(fso.GetFileName(in_filename))
If (Not objFolderItem Is Nothing) Then
' 画像ファイル「picture」であることを確認する
result = objFolderItem.ExtendedProperty("System.Kind")
If result(0) = "picture" Then
' 画像の幅
out_width = objFolderItem.ExtendedProperty("System.Image.HorizontalSize")
' 画像の高さ
out_height = objFolderItem.ExtendedProperty("System.Image.VerticalSize")
GetImageSize = True
End If
End If
End If
End Function【補足】
以下の関数を使用していますので、リンクから関数をコピーします。
最終行（Row）の次の行Rangeを取得（空白まで） – GetBlankNextRange()
FileSystemObject を使用しています。
初期設定では、エラーが発生するので、参照設定「Microsoft Scripting Runtime」の設定が必要です。
Windowsのシェルオブジェクトを使用しています。
初期設定では、エラーが発生するので、参照設定「Microsoft Shell Controls And Automation」の設定が必要です。
ExtendedProperty の引数の詳細は以下のサイトを確認してください。
System.Image.HorizontalSize – Microsoft Learn
System.Image.VerticalResolution – Microsoft Learn
複数の項目を返す場合には、Typeを使用した方が煩雑にならないので、こちらも参考に。
上のプログラムは幅と高さのみなのでByValの引数で値を戻しています。
幅と高さを取得できなかった場合の判定方法が変わるので注意してください。
【サンプルプログラム】
Type ImgData
width As Long ' 幅
height As Long ' 高さ
End Type
' フォルダにある画像ファイルからサイズを取得する
Sub GetSizeOfImgFileInFolder(ByVal path As String)
Dim fso As FileSystemObject
Set fso = New FileSystemObject
' ファイルを検索
FindImgFileList fso, path, Sheets("Sheet2"), "A1"
End Sub
' フォルダを検索
Sub FindImgFileList(fso As FileSystemObject, parent_path As Variant, ws As Worksheet, start_pos As String)
Dim path As Variant
Dim width As Long
Dim height As Long
Dim result As ImgData
Dim last_rgn As Range
' フォルダ内のサブフォルダを検索 (サブフォルダが不要なら削除)
For Each path In fso.GetFolder(parent_path).SubFolders
Call FindImgFileList(fso, path, ws, start_pos) ' 再帰検索
Next
' フォルダ内のファイルを検索
For Each path In fso.GetFolder(parent_path).Files
' 画像の幅と、高さを取得します
result = GetImageSize(path)
If result.width <> -1 Then
Set last_rgn = GetBlankNextRange(ws, start_pos)
' データの追加
If last_rgn.Row <= 1 Then ' 先頭行の場合
' タイトル
last_rgn = "No."
last_rgn.Offset(0, 1) = "ファイル名"
last_rgn.Offset(0, 2) = "幅"
last_rgn.Offset(0, 3) = "高さ"
' 一件目をタイトルの下に追加する
Set last_rgn = last_rgn.Offset(1, 0)
' 一件目をなのでNo.に 1 をセットする
last_rgn = 1
Else
' 2行目以降の場合は、前の数値に+1
last_rgn = last_rgn.Offset(-1, 0) + 1
End If
last_rgn.Offset(0, 1) = path
last_rgn.Offset(0, 2) = result.width
last_rgn.Offset(0, 3) = result.height
End If
Next
End Sub【関数化】
' ------------------------------------------------------------
' 説明：画像ファイルのパスを指定して、画像の幅と、高さを取得します
' 引数：1:画像ファイルのパス
' 戻値：画像の幅と高さを格納したType。取得できなかった場合(画像ファイル以外の場合も)は幅と高さに -1がセットされる。
' ------------------------------------------------------------
Function GetImageSize(in_filename As Variant) As ImgData
Dim objShell As Shell
Set objShell = New Shell ' Shell オブジェクトの作成
Dim fso As FileSystemObject
Set fso = New FileSystemObject ' オブジェクトの作成
Dim objFolder As Folder3
Dim objFolderItem As FolderItem2
Dim result As Variant
Dim ret As ImgData
' 取得できなかった時のため初期化
ret.width = -1
ret.height = -1
Set objFolder = objShell.Namespace(fso.GetParentFolderName(in_filename))
If (Not objFolder Is Nothing) Then
Set objFolderItem = objFolder.ParseName(fso.GetFileName(in_filename))
If (Not objFolderItem Is Nothing) Then
' 画像ファイル「picture」であることを確認する
result = objFolderItem.ExtendedProperty("System.Kind")
If result(0) = "picture" Then
' 画像の幅
ret.width = objFolderItem.ExtendedProperty("System.Image.HorizontalSize")
' 画像の高さ
ret.height = objFolderItem.ExtendedProperty("System.Image.VerticalSize")
End If
End If
End If
GetImageSize = ret
End Function
コメント