[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『メディアファイルの情報を取得して一覧表にするマクロ』（動画ファン）
以下の続編となります。
『動画ファイルのビットレート』
https://www.excel.studio-kazu.jp/kw/20230914134434.html
『動画ファイルのビットレート』でどうも解決しそうにないので
何かNETで情報を拾えないかと思って探したら以下に行き当たりました。
『動画や写真などのメディアファイルの情報を取得して一覧表にするマクロ Excel VBA』
https://ameblo.jp/hiromi-0505/entry-12570644470.html
コマンドライン版のMediaInfoは以下から入手
入手先：以下のV23.09(Winoes11 64bit CLI）
https://mediaarea.net/en/MediaInfo/Download/Windows
インストール（ZIP解凍先）
C:\Program Files\MediaInfo\MediaInfo_CLI_23.09_Windows_x64
C:\Program Files\MediaInfo\MediaInfo_CLI_23.09_Windows_x64\MediaInfo.exe
GUI版のMediaInfoを操作できているようでDOS窓は、一瞬表示されるので起動しているように思えます。
（思ってるだけかも？）
実情は、LISTシートの1行目にDictionaryの項目が書き出されるだけで
必要なそれぞれの情報が表示されずにエラー無く正常終了してしまいます。
（Dictionary ---＞ 取得したい項目は ttl = Array(........)で定義）
以下が現在のコードですがどこか間違いがあるのでしょうか？
その他、不足事項等あればアドバイスお願いします。
Option Explicit
Sub showMediaInfo()
Dim Itm As Variant
Dim mDic As Dictionary
Dim fd As FileDialog
Const sht = "List"
'ファイルの複数選択をする
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
If .Show = -1 Then 'ダイアログ表示
Sheets(sht).Cells.ClearContents
For Each Itm In .SelectedItems
Set mDic = getMediaInfo(Itm)
Call writeShtMediaInfo(sht, mDic)
Next Itm
Else 'キャンセルした時
'何もしない
End If
End With
Set fd = Nothing
Set mDic = Nothing
End Sub
Function writeShtMediaInfo(sht As String, mDic As Dictionary)
Dim ttl As Variant
Dim cl As Range, i As Long
ttl = Array("Folder name:General", _
"File name extension:General", _
"File size:General", _
"Duration:General", _
"Overall bit rate:General", _
"Frame rate:General", _
"DataSize:General", _
"Encoded date:General", _
"File creation date:General", _
"Bit rate:Video", _
"Width:Video", _
"Height:Video", _
"Display aspect ratio:Video", _
"Frame rate:Video", _
"Bit depth:Video", _
"Bit rate:Audio", _
"Maximum bit rate:Audio", _
"Channel layout:Audio", _
"Samples per frame:Audio", _
"Sampling rate:Audio", _
"Stream size:Audio")
With Sheets(sht)
Set cl = .Cells(1, 1)
For i = LBound(ttl) To UBound(ttl)
cl.Offset(0, i) = ttl(i)
Next
Set cl = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
For i = LBound(ttl) To UBound(ttl)
cl.Offset(0, i) = mDic.Item(ttl(i))
Next
End With
End Function
Function getMediaInfo(filepath As Variant) As Dictionary
'WshShellの参照設定は、VBA画面→ツールメニュー→参照設定で「Windows Script Host Object Model」を選択済み。
Dim Wsh As WshShell, wExec As Object
Dim exePath As String, exeOpt As String, exeCom As String
Dim StdO As Object, buf As Variant, kubun As String, j As Long
Dim mDic As Dictionary
Set mDic = New Dictionary
Set Wsh = New WshShell
' exePath = "cmd /c c:\aaaa\mediainfo -f "
' exeCom = exePath & """" & targetFile & """"
' Set wExec = WSH.exec(exeCom)
exePath = "C:\Program Files\MediaInfo\MediaInfo_CLI_23.09_Windows_x64\mediainfo.exe"
'exePath = "C:\Applications\MediaInfo_CLI_19.09_Windows_x64\mediainfo"
exeOpt = " -f "
exeCom = "cmd /c " & exePath & exeOpt & """" & filepath & """"
Set wExec = Wsh.Exec(exeCom)
Set StdO = wExec.StdOut
Do While Not StdO.AtEndOfStream
buf = StdO.ReadLine()
If buf = "" Then '区分が変わる。
kubun = ""
ElseIf InStr(1, buf, " : ") > 0 Then '項目と情報
buf = Split(buf, " : ")
For j = 0 To UBound(buf)
buf(j) = Trim(buf(j))
Next j
mDic.Item(buf(0) & ":" & kubun) = buf(1)
Else '" : "がない時は区分名
kubun = Trim(buf)
End If
Loop
Set getMediaInfo = mDic
Set mDic = Nothing
Set StdO = Nothing
Set wExec = Nothing
Set Wsh = Nothing
End Function
＜ 使用 Excel：Excel2021、使用 OS：Windows11 ＞
Sub getAttribute()
Dim wmp As Object
Dim media As Object
sFile = Application.GetOpenFilename("音楽ファイル,*.mp*") '要変更
If sFile = False Then Exit Sub
Set wmp = CreateObject("new:{6BF52A52-394A-11d3-B153-00C04F79FAA6}") 'WMP7
Set media = wmp.newMedia(sFile)
With ActiveSheet
.Range("A:B").ClearContents
For i = 0 To media.attributeCount - 1
.Cells(i + 1, 1).Value = media.getAttributeName(i)
.Cells(i + 1, 2).Value = media.getItemInfo(media.getAttributeName(i))
Next i
End With
End Sub
（kazuo） 2023/09/16(土) 17:48:38
＞（移動したようなので）
『動画ファイルのビットレート』の方は、停滞したままで
有益なアドバイスが無くなっています。
新しくMediaInfoを利用する方法を摸索する為に新しく質問を作成しました。
明日になっても『動画ファイルのビットレート』の方に進展しない場合は
閉じるさせていただきます。
頂いたコードでmp4のファイル名は書き出されました。
（getAttributeNameがファイル名相当だと思います。）
WMPを利用できるか試したいので
『動画ファイルのビットレート』の方で問題のファイルで求める事が出来なかった
Mp4の再生時間と総ビットレートを求めるgetAttributeに続く名前を教えてください。
（動画ファン） 2023/09/16(土) 18:55:39
記事には、質問する場所は提供されていないようですが
どのように問い合わせするか教えてもらえますか ？
（動画ファン） 2023/09/16(土) 19:03:17
＞Mp4の再生時間と総ビットレートを求めるgetAttributeに続く名前を教えてください。
意味不明ですが、以下のこと？
media.getItemInfo "Duration"
media.getItemInfo "Bitrate"
（kazuo） 2023/09/16(土) 19:30:56
https://learn.microsoft.com/ja-jp/windows/win32/wmp/duration-attribute
（kazuo） 2023/09/16(土) 22:18:20
＞＞ん！Mediaオブジェクトの８２ヶ程の属性が出力されるはずですが、
＞＞まずは、以前のコードでも普通に出力されるファイルで試して下さい
普通に問題なく出力されるファイルでテストしています。
82程の属性が出力されるとの事ですが、私のPCでは以下のようにファイル名だけしか出力されません。
SourceURL E:\test_ok\Ep01 AAA.mp4
私自身、普段はWMPを全く使用しないのでチェックしてら
「Windows Media Player Legacy」はインストールされているようですが
「Windows Media Player」の名前は見つからないので
こちらはインストールされていないようです。
調べてみたら、windows11では現在「Windows Media Player」ではなく
「Windows Media Player Legacy」に変更されているようですが？
ちなみにテストファイルの「Ep01 AAA.mp4」は「Windows Media Player Legacy」で問題なく再生されました。
今回のコードは、「Windows Media Player Legacy」でも利用できるコードですか？
＞＞私のはVer 12.0.19041.3208です。
私の「Windows Media Player Legacy」のVerの表示方法が良くわかりません。
Windows Media Player Legacy」プロパティを見ても記載が有りませんでした。
（検索しても「Windows Media Player」の方はヒットしますが
「Windows Media Player Legacy」については情報が拾えませんでした。）
（動画ファン） 2023/09/17(日) 05:44:38
以下の部分だけです。
exePath = "C:\Program Files\MediaInfo\MediaInfo_CLI_23.09_Windows_x64\mediainfo"
（以下にも変更してみましたが結果は同じでした。
exePath = "C:\Program Files\MediaInfo\MediaInfo_CLI_23.09_Windows_x64\mediainfo.exe"）
インストール（ZIPの解凍先）が「C:\Program Files￥-----」では問題があるのでしょうか？
（動画ファン） 2023/09/17(日) 06:01:11
exeファイルのパス中に spaceが入っているので、その対応が必要では？ # そんな話じゃなければ失礼。全体を読んでいる訳じゃないので。 （xyz） 2023/09/17(日) 06:23:29
＞＞パス中に spaceが入っているので、その対応が必要では？
調査の結果、
ご指摘のとうりフルパス中にスペースがある事が原因でした。
ZIP解凍先を変更して、項目（属性）が表示されるようになりました。
色々試していますが、どうも動画のコーデックの違いなどで動画によっては
上手く表示できる項目と出来ない項目があるようです。
（CLI版ではない普通のインストール版でも表示される項目と表示されない項目が
動画で違っている場合があります。）
CLI版のバージョンアップで表示されるようになるかも知れません。
おかげさまで解決できました。
お礼申し上げます。
（動画ファン） 2023/09/17(日) 07:33:37
例えば、
「Ep01 心の歌.mp」4 の場合
「ep1 蠢・・豁・mp4」のように表示されます。
これを文字化けしないようにコードを編集できる場合は教えてください。
（動画ファン） 2023/09/17(日) 08:32:04
＞私の「Windows Media Player Legacy」のVerの表示方法が良くわかりません。
先のコードでEnd Subにブレークポイントを置いて、
?wmp.versioninfo
して表示された値でした。wmpの画面表示とは異なるようです。
（kazuo） 2023/09/17(日) 10:56:30
現在のWMPでは利用できないと思われるのでこれ以上のサーチは止めておきます。
教えてもらった方法で私の「Windows Media Player Legacy」のVerの表示すると
「12.0.22621.2070」と表示されました。
お世話になりました。
'---------------------------------------------------------------------------
文字化けしないようにコードを編集できないので
VBAの達人さんは、もっと他のアプローチがあると思われるのでが、
苦肉の策でファイル名の所だけ正常に書き出されるように上書きするコードを追加しました。
以下現在のコードですが変更すべき事項などアドバイスあればお願いします。
Option Explicit
Sub showMediaInfo() 'コマンドライン版のMediaInfoを利用
'コマンドライン版のMediaInfo(64Bit CLI版)は､別途下記からZIPファイルを入手してください｡
'https://mediaarea.net/en/MediaInfo/Download/Windows
'MediaInfo は、WshShell の.execメソッドでファイルごとに呼び出していますので、
'選択ファイルの数だけDOS窓が一瞬起動しては消えていきます。
'初めて動かしたときは驚かれるかもしれませんが正常な状況で暴走しているわけではありません｡
Dim Itm As Variant
Dim mDic As Dictionary
Dim fd As FileDialog
Const sht = "List" '書き出すシート名はListに固定してあります。
Sheets(sht).Cells.ClearContents
Application.ScreenUpdating = False
'ファイルの複数選択をする
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.Title = "調査する動画ファイルを選択してください。（同一フォルダーなら複数可）"
With fd
If .Show = -1 Then 'ダイアログ表示
For Each Itm In .SelectedItems
Set mDic = getMediaInfo(Itm)
Call writeShtMediaInfo(sht, mDic)
Next Itm
Else 'キャンセルした時終了
MsgBox "処理は、キャンセルされました。", vbInformation
Exit Sub
End If
End With
With Sheets(sht)
.Cells(1, 1) = ""
.Cells(1, 2) = "ファイル名"
.Cells(1, 3) = "ファイルサイズ(GB)"
.Cells(1, 4) = "再生時間"
.Cells(1, 5) = "総ビットレート(kbps)"
.Cells(1, 6) = "動画ビットレート(kbps)"
.Cells(1, 7) = "動画(幅)"
.Cells(1, 8) = "動画(高さ)"
.Cells(1, 9) = "音声ビットレート(kbps)"
End With
Dim lcn As Long
Dim i As Long
lcn = Sheets(sht).Cells(Rows.Count, 2).End(xlUp).row
For i = 2 To lcn '再生時間をhh:mm:ssで表示
With Sheets(sht)
.Cells(i, 4) = Left(.Cells(i, 4), 8)
End With
Next
'A列のパスは必要ないので削除
Columns(1).Delete
'-----以下は、ファイル名が文字化けするので改めてファイル名だけ上書きする処理
Dim folderPath As Variant
folderPath = fd.InitialFileName
Dim fso As Object
Dim folder As Object
Dim file As Object
Dim shell As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderPath)
Set shell = CreateObject("Shell.Application")
Dim varFolPath As Variant
Dim objFld As Variant
Dim bitrate As Long
Dim row As Long
varFolPath = folderPath
Set objFld = shell.Namespace(varFolPath)
row = 2
For Each file In folder.Files
If LCase(fso.GetExtensionName(file.path)) = "mp4" Then
Sheets(sht).Cells(row, 1) = file.Name 'ファイル名
row = row + 1
End If
Next file
'列幅自動調整
Sheets(sht).Columns("A:I").AutoFit
Application.ScreenUpdating = True
Set fd = Nothing
Set mDic = Nothing
End Sub
Function writeShtMediaInfo(sht As String, mDic As Dictionary)
Dim ttl As Variant
Dim cl As Range, i As Long
' 取得したい項目は、ttl = Array(........) で定義しています。
ttl = Array("Folder name:General", _
"File name extension:General", _
"File size:General", _
"Duration:General", _
"Overall bit rate:General", _
"Bit rate:Video", _
"Width:Video", _
"Height:Video", _
"Bit rate:Audio")
With Sheets(sht)
Set cl = .Cells(1, 1)
For i = LBound(ttl) To UBound(ttl)
cl.Offset(0, i) = ttl(i)
Next
Set cl = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
For i = LBound(ttl) To UBound(ttl)
cl.Offset(0, i) = mDic.Item(ttl(i))
Next
End With
End Function
Function getMediaInfo(filepath As Variant) As Dictionary
'WshShellの参照設定は、VBA画面→ツールメニュー→参照設定で「Windows Script Host Object Model」を選択します。
Dim Wsh As WshShell, wExec As Object
Dim exePath As String, exeOpt As String, exeCom As String
Dim StdO As Object, buf As Variant, kubun As String, j As Long
Dim mDic As Dictionary
Set mDic = New Dictionary
Set Wsh = New WshShell
'exePathファイルのフルパス中に spaceが入っていると起動しないので注意 ！！
exePath = "C:\Applications\MediaInfo_CLI_23.09_Windows_x64\MediaInfo"
exeOpt = " -f "
exeCom = "cmd /c " & exePath & exeOpt & """" & filepath & """"
Set wExec = Wsh.Exec(exeCom)
Set StdO = wExec.StdOut
Do While Not StdO.AtEndOfStream
buf = StdO.ReadLine()
If buf = "" Then '区分が変わる。
kubun = ""
ElseIf InStr(1, buf, " : ") > 0 Then '項目と情報
buf = Split(buf, " : ")
For j = 0 To UBound(buf)
buf(j) = Trim(buf(j))
Next j
mDic.Item(buf(0) & ":" & kubun) = buf(1)
Else '" : "がない時は区分名
kubun = Trim(buf)
End If
Loop
Set getMediaInfo = mDic
Set mDic = Nothing
Set StdO = Nothing
Set wExec = Nothing
Set Wsh = Nothing
End Function
（動画ファン） 2023/09/17(日) 12:01:24
すいません。
「Ep01 心の歌.mp4」の間違いです。
「たたしく」 ----＞ ただしく（正しく）ですよね。
＞＞拡張子「.mp」は存在しません。
今回は、私の記載ミスですが調べてもらえれば判ると思いますが
拡張子「.mp」は存在します。
（動画ファン） 2023/09/17(日) 12:23:23
解決されたので余談ということになります。
文字化けとのことですが、ADODBなどを使って変換する方法もあると思います。 ただ、なぜEp01がep1になるんだろうかとか、なぜその項目だけそうなるのか、 単にそのファイルだけのデータの誤りかもしれないし、 副作用が別途発生するかもしれない、などと漠然と思って時が過ぎました（単なる感想です）。 ベストの対応をされたように思います。
あと、スペース対応ですが、（既に対応されていた）対象ファイルを""で囲むのと同じ方法を、 exeファイルのパスにも同様に適用すれば、特にインストール先を変更しなくてもよかったかもしれません。 先刻ご承知の方法かと思っていました。言葉足らずでしたね。 （xyz） 2023/09/17(日) 14:46:36
あ！、失礼しました。
ファイル名だけを取り出して文字列の文字化けを修正しようとして
EXCELで試行錯誤して変換中に
Ep01がep01になってしまっていたのをそのままに記載してしまいました。
＞＞特にインストール先を変更しなくてもよかったかもしれません。
インストールの件は、アドバイスで
Zipの解凍先を変更するだけなのでそれほどの手間がかからずに
問題が修正できたので気になさらないでください。
＞＞文字化けとのことですが、ADODBなどを使って変換する方法もあると思います。
ADODBが何なのか？
さっぱり理解できていません。
今回は文字化けを「上書き」と言う強引な方法で処理しましたが
勉強のためお聞きしますが、
文字化けしたファイル名のセルをターゲットとしてADOBを利用して
文字化けしない文字列に変換すると言う手法でしょうか？
何か素人にも判りそうな参考になるURLがあれば紹介ください。
（動画ファン） 2023/09/17(日) 16:10:44
素人ではないようにお見受けします。 こちらのサイトで「全文検索」していただくと参考記事が多くあると思います。
（xyz） 2023/09/17(日) 20:05:30
いえいえ素人の域はでいません。
掲載したコードは、
ほぼ最初の『動画や写真などのメディアファイルの情報を取得して一覧表にするマクロ Excel VBA』
のコードで私が変更したのは簡単な数コードです。
＞＞こちらのサイトで「全文検索」していただくと参考記事が多くあると思います。
参考になりそうな記事を見つけました。
『日本語Shift_jisに変換』
https://www.excel.studio-kazu.jp/kw/20230619100018.html
思うに現在のコードではファイル名を拾ってきているのは
Function getMediaInfo(filepath As Variant)の部分ですが
MediaInfoと言う海外産のサードパーティのアプリでファイル名を読み込んでいます。
この場合でも、上記の記事は利用できますか？
（動画ファン） 2023/09/18(月) 04:45:07
一般的な文字コード変換の手法を紹介したまでです。 どのようにencodeされたものかも不明なので、私にはわかりません。 また、私はそれの解明に時間を割くつもりはありません。 他の方からのコメントをお待ちください。 既に書きましたとおり、別の手法で文字化けしないファイル名があるのですから、 それをそのまま使用することをお薦めします。
（xyz） 2023/09/18(月) 10:04:04
（動画ファン） 2023/09/18(月) 10:34:42
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.