Consulting

Results 1 to 6 of 6

Thread: Get duration of mp4 files

  1. #1
    VBAX Regular
    Joined
    Dec 2011
    Posts
    33
    Location

    Get duration of mp4 files

    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.

  2. #2
    VBAX Regular JBeaucaire's Avatar
    Joined
    Sep 2014
    Location
    Bakersfield
    Posts
    32
    Location
    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
    Microsoft MVP 2010 - Excel
    Visit: Jerry Beaucaire's Excel Files & Macros

    “None of us is as good as all of us” - Ray Kroc
    “Actually, I *am* a rocket scientist.” - JB (little ones count!)

  3. #3

    Quicker/Alternate method of returning video file duration/length (MP4, MPG, AVI, etc)

    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)

  4. #4
    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.
    Last edited by Aussiebear; 11-26-2021 at 06:07 AM. Reason: Removed link within post

  5. #5
    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

  6. #6
    The following, based on 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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •