Excel·VBA读取文件信息shell

shell32可以方便的获取文件信息《用于脚本和 Microsoft Visual Basic的 Shell 对象》

获取单个文件的所有信息

Sub 获取文件信息()
    'MsgBox弹出单个文件的所有信息，《注意文件名不能有空格》
    filename = "D:\media\movie\飞驰人生.mp4"
    Dim fso As Object, shl As Object, shfd As Object, f As Object, i&, str$
    Set fso = CreateObject("Scripting.FileSystemObject")
    file_path = fso.GetParentFolderName(filename)  '文件路径
    file_name = fso.GetFileName(filename)          '文件名
    
    Set shl = CreateObject("Shell.Application")
    Set shfd = shl.Namespace(file_path)
    For Each f In shfd.Items
        'Debug.Print f.Name, file_name
        If f.Name = file_name Then
            For i = 1 To 32
                str = str & f.Name & "---" & i & "---" & shfd.GetDetailsOf(shfd.Items, i) & "---" & shfd.GetDetailsOf(f, i) & vbCrLf
            Next
            MsgBox str
        End If
    Next
End Sub

运行结果

获取音频、视频文件时长

Function video_duration(filename)
    '获取音频、视频文件时长
    Dim fso As Object, shl As Object, shfd As Object, f As Object, i&
    Set fso = CreateObject("Scripting.FileSystemObject")
    file_path = fso.GetParentFolderName(filename)  '文件路径
    file_name = fso.GetFileName(filename)          '文件名
    
    Set shl = CreateObject("Shell.Application")
    Set shfd = shl.Namespace(file_path)
    For Each f In shfd.Items
        If f.Name = file_name Then
            For i = 1 To 32
                If shfd.GetDetailsOf(shfd.Items, i) = "时长" And shfd.GetDetailsOf(f, i) <> "" Then
                     video_duration = shfd.GetDetailsOf(f, i): Exit Function
                End If
            Next
        End If
    Next
    video_duration = "文件无时长"
End Function

按视频时长移动至文件夹

在使用《python视频编辑ffmpeg》，TS格式视频转mp4格式中，部分视频可能会转换失败，没有将完整时长的TS转为mp4，因而需要将这部分转换失败的视频移动到单独文件夹

Sub 同名视频文件按时长分类()
    '注意new_path必须为路径，否则报错；文件较多的情况下，获取时长信息也较费时
    Dim dict As Object, fso As Object, shl As Object, shfd As Object, f As Object, i&
    file_path = "D:\media\TS"
    new_path = "D:\media\TS\错误\"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set dict = CreateObject("scripting.dictionary")
    Set shl = CreateObject("Shell.Application")
    Set shfd = shl.Namespace(file_path)
    For Each f In shfd.Items
        name_b = fso.GetBaseName(f.Name): name_e = UCase(fso.GetExtensionName(f.Name))  '文件名和扩展名
        If Len(name_e) Then  '排除文件夹
            If Not dict.Exists(name_b) Then
                Set dict(name_b) = CreateObject("scripting.dictionary")  '字典嵌套
            End If
            For i = 1 To 32
                If shfd.GetDetailsOf(shfd.Items, i) = "时长" And shfd.GetDetailsOf(f, i) <> "" Then
                     dict(name_b)(name_e) = shfd.GetDetailsOf(f, i): Exit For  '时长赋值
                End If
            Next
            If dict(name_b)(name_e) = "" Then dict.Remove (name_b)  '排除非视频文件
        End If
    Next
    k = dict.keys
    For i = 0 To dict.count - 1:   '遍历字典
        If dict(k(i))("MP4") < dict(k(i))("TS") Then  '时长小于
            file1 = file_path & "\" & k(i) & "." & "MP4"
            file2 = file_path & "\" & k(i) & "." & "TS"
            fso.MoveFile file1, new_path  '移动文件
            fso.MoveFile file2, new_path
            'Debug.Print k(i)
        End If
    Next
    Debug.Print "文件夹视频整理完成"
End Sub