VBSで動画ファイルの時間を読み取る方法

Question

複数の動画ファイルをD&Dして、ファイル名に更新時間と動画時間（動画ファイルのプロパティのビデオの欄に表示される「長さ」という項目）
をファイル名に追加するプログラムを書きたいと考えています。

更新時間を書き込む方法は

http://www.vector.co.jp/soft/winnt/util/se501476.html

のvbsを参考に作ることができました。

動画時間の読み取りに関しては

http://q.hatena.ne.jp/1312251379

に書かれてあるのですが、うまくいきません。
ExtendedPropertyのところで、
オブジェクトでサポートされていないプロパティまたはメソッドです。
というエラーが出て実行することができません。

以下が、作りかけですが、作成したプログラムです。

WScript.Echo "Duration : [" & CStr(objFile.ExtendedProperty2("Duration")) & "]" ' 単位は 100ns
のところをどのように書き換えれば良いか教えていただけないでしょうか？

Dim stArrayData

Dim objParam
Set objParam = WScript.Arguments'D&Dでの読み込みを可能にする

Dim objFs
Set objFs = WScript.CreateObject("Scripting.FileSystemObject")

' 引数の全ファイルについてファイル名を変更する
Dim objFile
Dim dtLastModified
Dim strLastModified
Dim i

Const FMTID_AudioSummaryInformation = "{64440490-4C8B-11D1-8B70-080036B11A03}"

For i = 0 To objParam.Count - 1 
If objFs.FileExists(objParam(i)) Then
Set objFile = objFs.GetFile(objParam(i))

' DateLastModifiedのフォーマットが環境によって違うかもしれないので
' いったんDate型にする
dtLastModified = CDate(objFile.DateLastModified)

If Hour(dtLastModified) < 10 Then
strLastModified = strLastModified & "0"
End If
strLastModified = strLastModified & Hour(dtLastModified)

If Minute(dtLastModified) < 10 Then
strLastModified = strLastModified & "0"
End If
strLastModified = strLastModified & Minute(dtLastModified)

' ファイル名を設定
stArrayData = split(objFile.Name, ".")
objFile.Name = stArrayData(0) & "-" & strLastModified & "." & stArrayData(1)

WScript.Echo "FileName : [" & objFile.Name & "]"
       WScript.Echo "Duration : [" & CStr(objFile.ExtendedProperty2("Duration")) & "]" ' 単位は 100ns
       WScript.Echo "FMTID_AudioSummaryInformation,3 : [" & CStr(objFile.ExtendedProperty(FMTID_AudioSummaryInformation & " 3") ) & "]" ' 単位は 100ns

Set objFile =  Nothing
End If
Next

Set objFs = Nothing
Set objParam = Nothing

NotFound404 · Accepted Answer

こんな感じでしょうかね。
秒の四捨五入は意図をくみ取れなかったので考えていません。
そちらで何とかしてください。
他の部分（日付をまたがる場合、再生時間を取得できないファイルの場合）は
多分、大丈夫かな？と。Windows7で簡単なテストは行いました。

Dim objParam
    Set objParam = WScript.Arguments 'D&Dでの読み込みを可能にする
    
    Dim objFS
    Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
    
    ' 引数の全ファイルについてファイル名を変更する
    Dim objFile
    Dim dtRecordStart
    Dim i
    Dim newName
    
    For i = 0 To objParam.Count - 1
If objFs.FileExists(objParam(i)) Then 
Set objFile = objFS.getFile(objParam(i))
dtRecordStart = GetDuration(objParam(i))    'ExtendedProperty用
'dtRecordStart = GetDuration2(objParam(i)) 'GetDetailsOf用

If dtRecordStart <> 0 Then
dtRecordStart = objFile.DateLastModified - (dtRecordStart / 3600 / 24)
newName = Right("0" & CStr(Hour(dtRecordStart)), 2) & Right("0" & CStr(Minute(dtRecordStart)), 2)
objFile.Name = objFS.getBaseName(objFile) & "-" & newName & "." & objFS.getExtensionName(objFile)
End If
Set objFile = Nothing
End If
    Next
    
    Set objFS = Nothing
    Set objParam = Nothing

Function GetDuration(filePath)
'再生時間の秒数を求めます
    Const FMTID_AudioSummaryInformation = "{64440490-4C8B-11D1-8B70-080036B11A03}"
    Dim objShell, objFolder, objItem
    Dim tmpStr
    
    tmpStr = Left(filePath, InStrRev(filePath, "\", -1, vbTextCompare))
    '親フォルダを求めて
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(tmpStr)
    
    tmpStr = Mid(filePath, InStrRev(filePath, "\", -1, vbTextCompare) + 1)
    '拡張子を含めたファイル名のみを求めて
    For Each objItem In objFolder.Items
       If StrComp(objItem.Name, tmpStr, vbTextCompare) = 0 Then
        'アイテムの名前とファイル名が同じなら
        GetDuration = CDbl(objItem.ExtendedProperty("Duration"))
        GetDuration = Int(GetDuration / 1000 / 1000 / 10)
        Exit For
        End If
    Next
'オブジェクトの解放未処理 
End Function

Function GetDuration2(filePath)
    Dim objShell
    Dim objFS, objFolder, objFile
    Dim tmpStr

Set objShell = CreateObject("Shell.Application")
    Set objFS = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFS.getFile(filePath)
    Set objFolder = objShell.Namespace(objFile.ParentFolder.Path)

tmpStr = objFolder.GetDetailsOf(objFolder.ParseName(objFile.Name), 27)
    'WindowsXPなら、27 → 21

If tmpStr = "" Then
GetDuration2 = 0
Else
    GetDuration2 = CDbl(CDate(tmpStr) * 3600 * 24)
'文字列型の時間を日付時刻型にしてから秒数を求めています
End If

'オブジェクトの解放未処理
End Function

NotFound404 · Answer

再生時間を取得する部分をFunction Moduleにすればスッキリすると思いますが、
手を付け始める前に確認。
たとえば、オリジナルのファイルが
ファイル名：video.avi で
更新時間：2014/08/17 9:9:9
動画再生時間:300930000（ExtendedPropertyで得られた値、約30秒）
や
更新時間：2014/08/17 19:9:9
動画再生時間:40000000000（ExtendedPropertyで得られた値、1時間16分40秒）
の時に
希望するファイル名は具体的にどんな名前にしたいのでしょう。

>GetDetailsof　を使うメリットは
一般的かどうかは分かりませんが、扱いやすいからかな・・。
一度にごそっと情報が取れますから。
ExtendedProperty だと得たい情報によって
FMTID と PID を組み替える必要があります。
デメリットはあなたが危惧されているように
OSのバージョンによって変わってくる可能性があることですが
#2の回答のようにExcelなどで確認しておいて
（試してみましたか！？）
OSのバージョンによって条件分岐でしょうかねー。
どちらを使うかはケースバイケースになりそうです。
GetDetailsOfでも再生時間はVista以降ならOSの違いを考慮する必要はなさそうです。
こちらの件に関しては別途ご質問を。ご了承ください。

NotFound404 · Answer

失礼しました。頓珍漢な回答をしてしまいました。
なぜエラーになるかは
>WScript.Echo "Duration : [" & CStr(objFile.ExtendedProperty2("Duration")) & "]" ' 単位は 100ns
>WScript.Echo "FMTID_AudioSummaryInformation,3 : [" & CStr(objFile.ExtendedProperty(FMTID_AudioSummaryInformation & " 3") ) & "]" ' 単位は 100ns
で指定しているobjFile を
Set objFile = objFs.GetFile(objParam(i)) にしてしまっています。
これは、Scripting.FilesystemObject のメンバーです。

なので、あなたが参考にされた
http://q.hatena.ne.jp/1312251379
のように、 Set objShell = CreateObject("Shell.Application")
から生成されるモノ（とでも言ったらいいのか）でなければなりません。
まったく別のモノですのでエラーになります。
更新時間を変更するために使用するObjectと、
Duration（長さ）を取得するのに使用するObjectを分けて考えてみてください。
（Windows8.1でもあのサンプルVBSは問題ありませんでした）

またまた蛇足です。。。
>７と８とは順番が異なります。
前言撤回一部修正
７と８とは順番が異なるものが少しあります。
もしExcelをお持ちなら下記を標準モジュールで試してみてください。
（Win7 Excel2010で作成）
Sub GetDetailsOfList()
    '↓はそちらの適当な動画ファイルのフルパスに、Win7なら変更しないでも大丈夫かもしれない
    Const trgFile As String = "C:\Windows\winsxs\amd64_microsoft-windows-videosamples_31bf3856ad364e35_6.1.7600.16385_none_51a21f033003affd\Wildlife.wmv"
    Dim oSH As Object
    Dim oFS As Object
    Dim oFLD As Object
    Dim oF As Object
    Dim i As Long
    Dim Sht As Worksheet
  
    Set oSH = CreateObject("Shell.Application")
    Set oFS = CreateObject("Scripting.FileSystemObject")
    Set oF = oFS.getfile(trgFile)
    Set oFLD = oSH.Namespace(oF.ParentFolder.Path)
    Set Sht = Sheets("Sheet1")
  
    Sht.Cells.Clear
    Sht.Cells(1, 1) = "No": Sht.Cells(1, 2) = "Windows7 64bit"
    Sht.Cells(2, 1) = "0": Sht.Cells(2, 2) = "Name"
     
     For i = 1 To 300    '余計なもの？も出てくる。300はテキトーな値です
            Sht.Cells(i + 2, 1) = i
            Sht.Cells(i + 2, 2) = oFLD.GetDetailsOf(oFLD.Items, i)
            Sht.Cells(i + 2, 3) = oFLD.GetDetailsOf(oFLD.ParseName(oF.Name), i)
     Next
  
    Sht.Columns("A:B").EntireColumn.AutoFit
    Sht.Columns("C:C").ColumnWidth = 30

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

End Sub

NotFound404 · Answer

>WScript.Echo "Duration : [" & CStr(objFile.ExtendedProperty2("Duration")) & "]" ' 単位は 100ns
2 が余計です。ExtendedProperty

オマケ（蛇足）ですがファイル情報は
GetDetailsof を使っても。
http://d.hatena.ne.jp/palm84/20130518/1368854185
ただし、結果はOSのバージョンによって変わってきます。
XPだと４０個ほどしか取得できませんし、
７・８なら２９７個取得できますが、７と８とは順番が異なります。

VBSで動画ファイルの時間を読み取る方法

こんな感じでしょうかね。

再生時間を取得する部分をFunction Moduleにすればスッキリすると思いますが、

失礼しました。

>WScript.Echo "Duration : [" & CStr(objFile.ExtendedProperty2("Duration")) & "]" ' 単位は 100ns

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング