Excel2007+Window7でＶＢＡを使い

質問

ＴＩＦファイルの枚数を数えたいのです。
ＴＩＦは既定でWindowsフォトビューアーが開かれます。
そのプロパティを取得すればよいと思いますが
どの様にすればよいのでしょうか。。。
宜しくご回答願います。

回答No.4

nicotinism · ベストアンサー

どうもWindow7ではTifファイルのページ数が取得できなさそうなので
下記を参考（丸コピ）させてもらいました。
http://blogs.yahoo.co.jp/ussr1917jp/17686408.html
今までの１～３の回答はきれいさっぱり忘れてください。
これで取得出来なかったら、降参です。
以下を全て標準モジュールに。

'http://blogs.yahoo.co.jp/ussr1917jp/17686408.html
' GDIPlus
Public Type TGpStartupInput
　　GdiplusVersion As Long
　　DebugEventCallback As Long
　　SuppressBackgroundThread As Long
　　SuppressExternalCodecs As Long
End Type
Public Type TGpStartupOutput
　　NotificationHook As Long
　　NotificationUnhook As Long
End Type
Public Type UUID
　　Data1 As Long
　　Data2 As Integer
　　Data3 As Integer
　　Data4A As Byte
　　Data4B As Byte
　　Data4C As Byte
　　Data4D As Byte
　　Data4E As Byte
　　Data4F As Byte
　　Data4G As Byte
　　Data4H As Byte
End Type
' GDIスタート
Public Declare Function GdiplusStartup Lib "gdiplus.dll" ( _
　　ByRef RetToken As Long, _
　　GpInput As TGpStartupInput, _
　　GpOutput As TGpStartupOutput) As Long
' GDIの破棄
Public Declare Sub GdiplusShutdown Lib "gdiplus.dll" ( _
　　ByVal Token As Long)
' GDIファイルの読み込み
Public Declare Function GdipLoadImageFromFile Lib "gdiplus.dll" ( _
　　ByRef FileName As Byte, _
　　ByRef RetGpImage As Long) As Long
' GDIイメージカウントの取得
Public Declare Function GdipImageGetFrameDimensionsCount Lib "gdiplus.dll" ( _
　　ByVal GpImage As Long, _
　　ByRef RetCount As Long) As Long
' GDIイメージリストの取得
Public Declare Function GdipImageGetFrameDimensionsList Lib "gdiplus.dll" ( _
　　ByVal GpImage As Long, _
　　RetArDimensionIDs As UUID, _
　　ByVal COUNT As Long) As Long
' GDIフレーム数の取得
Public Declare Function GdipImageGetFrameCount Lib "gdiplus.dll" ( _
　　ByVal GpImage As Long, _
　　DimensionID As UUID, _
　　ByRef RetCount As Long) As Long

'GDIイメージの破棄
Public Declare Function GdipDisposeImage Lib "gdiplus.dll" ( _
　　ByVal GpImage As Long) As Long

'Tiffファイルの枚数のチェック
'戻り値　：　ページ数
'=======================================================
Private Function fncImegeCount(ByVal strPath As String) As Long
　　Dim gsi As TGpStartupInput
　　Dim gdiOut As TGpStartupOutput
　　Dim lngGdiPlusTolen As Long
　　Dim bytPath() As Byte
　　Dim lngGpImage As Long
　　Dim lngVarType As VbVarType
　　Dim lngResult As Long

　　On Error GoTo ERRCOM:

　　' 構造体初期化
　　With gsi
　　　　.GdiplusVersion = 1
　　　　.DebugEventCallback = 0
　　　　.SuppressBackgroundThread = 0
　　　　.SuppressExternalCodecs = 0
　　End With
　　' GDI+初期化
　　lngResult = GdiplusStartup(lngGdiPlusTolen, gsi, gdiOut)

　　' ファイル名の指定
　　strPath = strPath & vbNullChar

　　' 文字列バイト変換
　　bytPath = strPath

　　' ファイルの取得
　　Call GdipLoadImageFromFile(bytPath(0&), lngGpImage)

　　If (0& = lngGpImage) Then Exit Function

　　' ページ数の取得
　　Dim PCnt As Long
　　Dim MUID As UUID
　　Dim Ret As Long

　　Call GdipImageGetFrameDimensionsCount(lngGpImage, PCnt)
　　Call GdipImageGetFrameDimensionsList(lngGpImage, MUID, PCnt)
　　Ret = GdipImageGetFrameCount(lngGpImage, MUID, PCnt)

　　'　イメージの開放
　　Call GdipDisposeImage(lngGpImage)

　　'　GDI+の開放
　　Call GdiplusShutdown(lngGdiPlusTolen)

　　fncImegeCount = True
　　'ページ数のSet
　　fncImegeCount = PCnt

　　Exit Function

ERRCOM:
　　MsgBox Err.Description
End Function

Sub makeTifList(trgDir As String)
'使い方 イミディエイトウィンドウで、maketiflist("d:\画像") などと入力
　　Dim oFs As Object
　　Dim oDir As Object
　　Dim oF As Object
　　Dim i As Integer

　　Set oFs = CreateObject("Scripting.FilesystemObject")
　　Set oDir = oFs.getfolder(trgDir)
　　　　For Each oF In oDir.Files
　　　　　　If oFs.getextensionname(oF.Path) = "tif" Then
　　　　　　　　i = i + 1
　　　　　　　　Worksheets(1).Cells(i, 1) = oF.Name
　　　　　　　　Worksheets(1).Cells(i, 2) = fncImegeCount(oF.Path)
　　　　　　　　Worksheets(1).Cells(i, 3) = oF.Path
　　　　　　End If
　　　　Next
　　Set oDir = Nothing: Set oFs = Nothing
End Sub

お礼

nicotinismさん＞
ありがとうございます＾＾
完璧にページを取得できました!!!
すごく助かりました～♪
ＸＰと７ってずいぶん違うものなんですね。。。

またよろしくお願いします<(_ _)>

回答No.3

nicotinism

その前に、ページ数があなたが欲しているものなのか
前回回答のファンクションモジュールを標準モジュールに丸コピペして

Ctrl + G を押して現れるイミディエイトウィンドウに

?fileInfo("C:\users・・・・なんとか.tif")
と入力し現れるメッセージボックスを確認してください。

補足

何度もご回答頂きありがとうございます。

MsgBoxは表示されるものの、結果が表示されないです。
どうしてでしょうか。。。？

＜追記＞
個々のＴＩＦファイルのページ数を取得したいのです。

回答No.2

nicotinism

失礼しました。枚数＝ページ数ならば、

Function fileInfo(ByVal trgFile As String) As String
'http://www.kixtart.org/forums/ubbthreads.php?ubb=showflat&Number=194237
　　Dim oSH As Object
　　Dim oFs As Object
　　Dim oFLD As Object
　　Dim oF As Object
　　Dim i As Long
　　Dim sTime As String
　　Dim NsTime As String

　　Set oSH = CreateObject("Shell.Application")
　　Set oFs = CreateObject("Scripting.FileSystemObject")
　　Set oF = oFs.getfile(trgFile)
　　Set oFLD = oSH.Namespace(oF.ParentFolder.Path)

　　'ここから下は撮影日時取得
　　sTime = oFLD.GetDetailsOf(oFLD.ParseName(oF.Name), 12)
　　For i = 1 To Len(sTime) 'ごみ取りのループ
　　　　If Mid(sTime, i, 1) Like "[0-9,/ :]" Then
　　　　　　NsTime = NsTime & Mid(sTime, i, 1)
　　　　End If
　　Next
　　MsgBox "撮影日時=" & NsTime

　　'index で決め打ち(OSによってIndexが変わってしまう148はWin7の場合)
　　MsgBox "決め打ちページ数=" & oFLD.GetDetailsOf(oFLD.ParseName(oF.Name), 148)

　　 For i = 1 To 300　　'余計なもの？も出てくる。300はテキトーな値です
　　　　If oFLD.GetDetailsOf(oFLD.Items, i) = "ページ数" Then
　　　　　　MsgBox "名前からページ数=" & oFLD.GetDetailsOf(oFLD.ParseName(oF.Name), 148)
　　　　End If
　　　　Debug.Print i, oFLD.GetDetailsOf(oFLD.Items, i),oFLD.GetDetailsOf(oFLD.ParseName(oF.Name),i)
　　 Next

　　'解放
　　Set oF = Nothing: Set oFLD = Nothing: Set oFs = Nothing: Set oSH = Nothing

End Function

trgFile にファイルのフルパスを渡してください。
なお、撮影日時を取得する余計なコードが含まれていますが、オマケということで・・。
イミディエイトウィンドウに出力するようにしていますが、
最初の方は消えてしまうのでExcelなどに書き出すようにしてください。

補足

ご回答ありがとうございます。
フォルダの中にある、複数のＴＩＦファイルのそれぞれのファイル名とページ数を
エクセル上に記述したいのです。

すみません。。。
Functionで始まるコードを使った事がないので、、、
コマンドボタンからどの様に動作させれば良いのでしょうか。。。<(_ _)>
もう少し詳しく教えて頂ければ助かります。

回答No.1

nicotinism

>ＴＩＦファイルの枚数を数えたいのです。
TIFファイルに『枚数』というプロパティって有りましたっけ？
念のため、Windowsフォトビューアーで開いて詳細タブの中のプロパティも
見てみましたが、当方では見当たりません。
フォルダの中のTIFファイルの個数の事を指しているのかな？