如何用VBA FileSystemObject批量获取视频时长供Excel/Power BI使用

注意：单独使用FileSystemObject无法读取视频编码内嵌的时长元数据，需配合Windows Shell扩展属性接口实现读取，最终输出统一为HH:MM:SS标准时间格式，可直接被数据分析工具识别。

方案一：VBA导出结构化表格到Excel #

• 打开任意Excel文件，按Alt+F11唤起VBA编辑器，在左侧工程栏右键点击当前工作簿名称，依次选择「插入」-「模块」，将后续提供的VBA代码粘贴到右侧代码编辑区
• 按F5运行宏，在弹出的文件夹选择框中选中需要扫描的视频存储根目录，代码会自动递归遍历所有层级子文件夹
• 扫描完成后会自动在当前活动工作表生成标准化表格，字段包含：文件完整路径、文件名、上级文件夹路径、时长（HH:MM:SS）、文件大小，可直接保存为xlsx或csv格式，无需额外处理即可导入Power BI

Sub 批量提取视频时长()
    Dim objShell As Object, objFolder As Object
    Dim fso As Object, rootFolder As Object
    Dim ws As Worksheet, lastRow As Long
    Dim videoExtArr As Variant
    
    ' 初始化参数
    Set ws = ActiveSheet
    ws.Cells.Clear
    ' 写入表头
    ws.Range("A1:E1") = Array("文件完整路径", "文件名", "所属文件夹", "时长(HH:MM:SS)", "文件大小(MB)")
    videoExtArr = Array("mp4", "avi", "mkv", "mov", "flv", "wmv", "mpeg", "mpg", "ts")
    lastRow = 2
    
    ' 选择根文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "选择要扫描的视频根文件夹"
        If .Show = -1 Then
            Set fso = CreateObject("Scripting.FileSystemObject")
            Set rootFolder = fso.GetFolder(.SelectedItems(1))
            Set objShell = CreateObject("Shell.Application")
        Else
            Exit Sub
        End If
    End With
    
    ' 递归遍历所有子文件夹处理文件
    Call TraverseFolders(rootFolder, objShell, fso, videoExtArr, ws, lastRow)
    
    ' 格式调整
    ws.Columns("A:E").AutoFit
    MsgBox "扫描完成，共提取" & lastRow - 2 & "个视频文件信息", vbInformation
    
    ' 释放对象
    Set objShell = Nothing
    Set fso = Nothing
    Set rootFolder = Nothing
    Set ws = Nothing
End Sub

Sub TraverseFolders(currentFolder As Object, objShell As Object, fso As Object, extArr As Variant, ws As Worksheet, ByRef lastRow As Long)
    Dim objFile As Object, subFolder As Object
    Dim objFolder As Object, durationRaw As String, t As Variant
    Dim h As String, m As String, s As String, fileExt As String
    Dim i As Integer, isVideo As Boolean
    
    ' 处理当前文件夹下的所有文件
    For Each objFile In currentFolder.Files
        fileExt = LCase(fso.GetExtensionName(objFile.Path))
        isVideo = False
        ' 判断是否为支持的视频格式
        For i = LBound(extArr) To UBound(extArr)
            If fileExt = extArr(i) Then
                isVideo = True
                Exit For
            End If
        Next i
        
        If isVideo Then
            Set objFolder = objShell.Namespace(currentFolder.Path)
            ' 读取时长属性（Windows系统中视频时长对应属性索引27）
            durationRaw = objFolder.GetDetailsOf(objFolder.ParseName(objFile.Name), 27)
            ' 转换为HH:MM:SS格式
            If durationRaw <> "" Then
                durationRaw = Replace(durationRaw, Chr(160), "")
                If InStr(durationRaw, ":") > 0 Then
                    t = Split(durationRaw, ":")
                    If UBound(t) = 2 Then
                        h = Format(t(0), "00")
                        m = Format(t(1), "00")
                        s = Format(t(2), "00")
                        durationRaw = h & ":" & m & ":" & s
                    ElseIf UBound(t) = 1 Then
                        h = "00"
                        m = Format(t(0), "00")
                        s = Format(t(1), "00")
                        durationRaw = h & ":" & m & ":" & s
                    End If
                Else
                    durationRaw = "无法读取"
                End If
            Else
                durationRaw = "无法读取"
            End If
            ' 写入表格
            ws.Cells(lastRow, 1) = objFile.Path
            ws.Cells(lastRow, 2) = objFile.Name
            ws.Cells(lastRow, 3) = currentFolder.Path
            ws.Cells(lastRow, 4) = durationRaw
            ws.Cells(lastRow, 5) = Round(objFile.Size / 1024 / 1024, 2)
            lastRow = lastRow + 1
        End If
    Next objFile
    
    ' 递归遍历子文件夹
    For Each subFolder In currentFolder.SubFolders
        ' 跳过系统隐藏文件夹
        If (subFolder.Attributes And 2) = 0 And (subFolder.Attributes And 4) = 0 Then
            Call TraverseFolders(subFolder, objShell, fso, extArr, ws, lastRow)
        End If
    Next subFolder
End Sub

方案二：Power BI直连读取（无需导出中间文件） #

• 打开Power BI Desktop，依次点击「获取数据」-「文件夹」，选择需要扫描的视频根目录，加载文件列表到Power Query编辑器
• 筛选文件扩展名字段，仅保留需要的视频格式，添加自定义列，通过M函数读取文件的时长扩展属性，转换为HH:MM:SS格式即可直接用于可视化分析
• 该方案支持后续文件夹新增文件后一键刷新，不需要重复跑提取流程

注意事项 #

• 未下载完成、加密、损坏的视频文件无法正常读取时长，结果会标记为「无法读取」，可手动核对
• 输出的时长字段为标准时间文本，导入Excel/Power BI后可自动识别为时间类型，直接支持时长求和、平均值计算等聚合操作
• 所有功能基于Windows原生接口实现，无需安装第三方插件，兼容Windows 10/11全版本、Office 2016及以上版本
• 扫描网络共享盘的视频文件时，建议先将共享路径映射为本地盘符，避免属性读取权限问题

内容的提问来源于stack exchange，提问作者Jeffs