PDA

View Full Version : Sleeper: Get duration of mp4 files



entwined
02-10-2017, 11:49 PM
Hello experts,

I would like to ask if there is a way to get the duration/length of video files (mine is mp4 file only) through vba code. The mp4's are located in one folder. A simple excel list will do for me (example below).

Filename Length
9001.mp4 00:28:36
9002.mp4 00:18:03
9003.mp4 00:20:09
9004.mp4 00:24:14

Any help will be very much appreciated. Thanks in advance. :)

JBeaucaire
02-11-2017, 01:09 AM
A generic tool for collecting specific properties of video files, add/remove the extensions you want to include in the ARRAY and then tweak the top path in the SHELL command, currently it starts at C:\ and dives into all folders from there, so it will find them all. Not the quickest, but it's thorough.



Option Explicit
Sub GetVideos()
Dim fileType, fileNames, movieFile
Dim nextRow As Excel.Range

For Each fileType In Array(".avi", ".mkv", ".mpeg4", ".mov") '// add more as required...
'// Black console box may appear at this point for a while, this is normal...
fileNames = Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR ""C:\*" & fileType & """ /S /B /A:-D").StdOut.ReadAll, vbCrLf), ".")
For Each movieFile In fileNames
Set nextRow = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
nextRow.Value = GetProperties(CStr(movieFile), 0)
nextRow.Offset(0, 1).Value = GetProperties(CStr(movieFile), 1)
nextRow.Offset(0, 2).Value = GetProperties(CStr(movieFile), 27)
nextRow.Offset(0, 3).Value = GetProperties(CStr(movieFile), 182)
nextRow.Offset(0, 4).Value = GetProperties(CStr(movieFile), 284)
Next
Next

With Range("A1:E1")
.Value = Array("Name", "Size", "Length", "Type", "Frame Rate")
.EntireColumn.AutoFit
End With

End Sub

Function GetProperties(file As String, propertyVal As Integer) As Variant
Dim varfolder, varfile
With CreateObject("Shell.Application")
Set varfolder = .Namespace(Left(file, InStrRev(file, "\") - 1))
Set varfile = varfolder.ParseName(Right(file, Len(file) - InStrRev(file, "\")))
GetProperties = varfolder.GetDetailsOf(varfile, propertyVal)
End With
End Function

ashleedawg
10-18-2018, 02:54 PM
A quicker/alternate method:


Function GetVideoDuration(fPName As String) As Long
'returns the duration in seconds of the specified video path+fPNamename
Dim oFolder, ofPName
With CreateObject("Shell.Application")
Set oFolder = .Namespace(Left(fPName, InStrRev(fPName, "\") - 1))
Set ofPName = oFolder.ParseName(Right(fPName, Len(fPName) - InStrRev(fPName, "\")))
GetVideoDuration = CDbl(TimeValue(oFolder.GetDetailsOf(ofPName, 27))) * 24# * 60# * 60#
End With
End Function

Usage:


MsgBox GetVideoDuration("x:\myPath\myVideo.mp4") 'returns a duration in seconds

...to instead have the duration represented a HH:MM:SS, shorten the third-to-last line to:


GetVideoDuration = oFolder.GetDetailsOf(ofPName, 27)

Desadas
11-26-2021, 05:45 AM
In my opinion, the most convenient way is the MsgBox command. Through it will specify the duration of the video file in seconds. There is only one problem with this command. It has to do with changing the file format. When I need to get the file's duration in AVI format, time is not displayed for some reason. I partially solved this problem by just converting the file to MP4 at convertr.org. But still, I need other options to solve this problem. If anyone has encountered something like this, I would be glad if you could share your thoughts.

arnelgp
11-26-2021, 08:16 PM
Private Sub testMe()
Const path As String = "c:\thePathOfMp4Here\"
Dim sFile As String
Dim c_file As New Collection
Dim i As Integer
sFile = Dir$(path & "*.mp4")
Do Until Len(sFile) = 0
i = i + 1
c_file.Add key:=i & "", Item:=sFile
sFile = Dir$
Loop
For i = 1 To c_file.count
With Range("A1")
.Offset(i-1,0) = c_file.Item(i)
.Offset(i-1,1) = getDuration(path, c_file.Item(i))
End With
Next
End Sub


Public Function getDuration(ByVal path As String, ByVal file As String) As Variant
With CreateObject("Shell.Application").NameSpace(path & "")
getDuration = .GetDetailsOf(.Items.Item(file & ""), 27)
End With
End Function

gmayor
11-27-2021, 11:16 PM
The following, based on arnelgp (http://www.vbaexpress.com/forum/member.php?74556-arnelgp)'s function, will recover the durations of a variety of video files in a folder, including AVI and MP4, here written to the immediate window.


Public Sub GetFileProperty()
Dim sPath As String
Dim sFile As String
Const lngLength As Long = 27

sPath = "C:\Path of Video files\"
sFile = Dir$(sPath & "*.*")
Do While sFile <> ""
Select Case Right(LCase(sFile), 3)
Case "mkv", "avi", "mp4"
Debug.Print sFile & " - Length: " & getDuration(sPath, sFile, lngLength)
Case Else
End Select
sFile = Dir$()
Loop
End Sub

Private Function getDuration(ByVal sPath As String, ByVal sFile As String, lngLength As Long) As Variant
Dim oShell As Object
Dim sDuration As String
Dim sLength As String
Dim vTime As Variant
Dim sHrs As String, sMins As String, sSecs As String
Set oShell = CreateObject("Shell.Application")
With oShell.NameSpace(sPath & "")
sLength = .GetDetailsOf(.Items.Item(sFile & ""), lngLength)
vTime = Split(sLength, Chr(58))
sHrs = "": sMins = "": sSecs = ""
If UBound(vTime) = 2 Then
If Val(vTime(0)) > 0 Then
sHrs = Format(vTime(0), "0") & " hour"
If Val(vTime(0)) > 1 Then
sHrs = sHrs & "s "
Else
sHrs = sHrs & " "
End If
End If
If Val(vTime(1)) > 0 Then
sMins = Format(vTime(1), "0") & " minute"
If Val(vTime(1)) > 1 Then
sMins = sMins & "s "
Else
sMins = sMins & " "
End If
End If
If Val(vTime(2)) > 0 Then
sSecs = Format(vTime(2), "0") & " second"
If Val(vTime(2)) > 1 Then
sSecs = sSecs & "s "
Else
sSecs = sSecs & " "
End If
End If
getDuration = sHrs & sMins & sSecs
End If
End With
Set oShell = Nothing
End Function