关于利用shell获取mp4文件的详细信息

绫小路sama

遇到这么一个问题
就是我有一个文件夹，文件夹中也有子文件夹若干层。每个文件夹和子文件夹中都包含若干MP4视频
能否使用vba在excel表中列出
1：文件完整路径
2：视频时长
3：帧宽度，帧高度
非常感谢

绫小路sama

Sub mysearch2()
    Dim Fso As New FileSystemObject
    Dim str As String
    Dim Filepath As String
    Dim FileName As String
    Dim fs, i, arr(1 To 10000)
    Set fs = Application.FileSearch '设置一个搜索对象
    Dim SearchPath As String
    Dim FileFormat As String
    Dim Findi As Integer
    Dim objShell, objFolder, objFolderItem, MyFile$, brr(20000, 200), n&
    Set objShell = CreateObject("shell.application")
        
               
   
    FileFormat = Application.InputBox("请输入即将被操作的文件格式")
    SearchPath = Application.InputBox("请输入目标路径，以\结尾", "提示")
   
    With fs
        .LookIn = SearchPath '设置搜索路径
        .FileName = "*." & FileFormat '要搜索文件名和类型
        .SearchSubFolders = True '是否需要搜索子文件 夹
        
        If .Execute > 0 Then '如果找到文件
            MsgBox "There were " & .FoundFiles.Count & " file(s) found." '显示找到多少个文件
            
            
            For i = 1 To .FoundFiles.Count
            
            
            
                FileName = Fso.GetFileName(.FoundFiles(i)) '获得文件名
                Filepath = Fso.GetParentFolderName(.FoundFiles(i))

                Range("B" & (i + 1)) = FileName
                Range("A" & (i + 1)) = Filepath & "\" & FileName
               
               
                 '---------------------------------------------------------------------------------------------
                objFolder = Filepath
                MyFile = Dir(objFolder & "\*.mp4")
                Set objFolder = objShell.Namespace(objFolder)
               
                Do While MyFile <> ""
                   Set objFolderItem = objFolder.ParseName(MyFile)
                   If n = 0 Then
                      For k = 0 To UBound(brr, 2)
                          brr(0, k) = objFolder.GetDetailsOf(0, k)
                          n = 1
                          brr(n, 0) = MyFile
                          brr(n, k) = objFolder.GetDetailsOf(objFolderItem, k)
                      Next
                    Else
                      For k = 0 To UBound(brr, 2)
                          brr(n, 0) = MyFile
                          brr(n, k) = objFolder.GetDetailsOf(objFolderItem, k)
                      Next
                    End If
                    n = n + 1
                    MyFile = Dir
                Loop

                '-------------------------------------------------------------------------------------------------
        
                Set objFolder = Nothing
            Next i
        Else
            MsgBox "There were no files found."
        End If
    End With

   
   
    Cells(1, 3).Resize(n + 1, UBound(brr, 2) + 1) = brr
    MsgBox "完成"
End Sub



这是网上找的代码自己拼接的，只能实现一小部分，但是始终有问题

绫小路sama

Sub mysearch2()
    Dim Fso As New FileSystemObject
    Dim str As String
    Dim Filepath As String
    Dim FileName As String
    Dim fs, i, arr(1 To 10000)
    Set fs = Application.FileSearch '设置一个搜索对象
    Dim SearchPath As String
    Dim FileFormat As String
    Dim Findi As Integer
    Dim objShell, objFolder, objFolderItem, MyFile$, brr(20000, 200), n&
    Set objShell = CreateObject("shell.application")
        
               
   
    FileFormat = Application.InputBox("请输入即将被操作的文件格式")
    SearchPath = Application.InputBox("请输入目标路径，以\结尾", "提示")
   
    With fs
        .LookIn = SearchPath '设置搜索路径
        .FileName = "*." & FileFormat '要搜索文件名和类型
        .SearchSubFolders = True '是否需要搜索子文件 夹
        
        If .Execute > 0 Then '如果找到文件
            MsgBox "There were " & .FoundFiles.Count & " file(s) found." '显示找到多少个文件
            
            
            For i = 1 To .FoundFiles.Count
            
            
            
                FileName = Fso.GetFileName(.FoundFiles(i)) '获得文件名
                Filepath = Fso.GetParentFolderName(.FoundFiles(i))

                Range("B" & (i + 1)) = FileName
                Range("A" & (i + 1)) = Filepath & "\" & FileName
               
               
                 '---------------------------------------------------------------------------------------------
                objFolder = Filepath
                MyFile = Dir(objFolder & "\*.mp4")
                Set objFolder = objShell.Namespace(objFolder)
               
                Do While MyFile <> ""
                   Set objFolderItem = objFolder.ParseName(MyFile)
                   If n = 0 Then
                      For k = 0 To UBound(brr, 2)
                          brr(0, k) = objFolder.GetDetailsOf(0, k)
                          n = 1
                          brr(n, 0) = MyFile
                          brr(n, k) = objFolder.GetDetailsOf(objFolderItem, k)
                      Next
                    Else
                      For k = 0 To UBound(brr, 2)
                          brr(n, 0) = MyFile
                          brr(n, k) = objFolder.GetDetailsOf(objFolderItem, k)
                      Next
                    End If
                    n = n + 1
                    MyFile = Dir
                Loop

                '-------------------------------------------------------------------------------------------------
        
                Set objFolder = Nothing
            Next i
        Else
            MsgBox "There were no files found."
        End If
    End With

   
   
    Cells(1, 3).Resize(n + 1, UBound(brr, 2) + 1) = brr
    MsgBox "完成"
End Sub

这是网上的代码自己进行拼接的，但是始终有问题，求各位大大帮忙

绫小路sama

1. Sub mysearch2()
   
2.     Dim Fso As New FileSystemObject
   
3.     Dim str As String
   
4.     Dim Filepath As String
   
5.     Dim FileName As String
   
6.     Dim fs, i, arr(1 To 10000)
   
7.     Set fs = Application.FileSearch '设置一个搜索对象
   
8.     Dim SearchPath As String
   
9.     Dim FileFormat As String
   
10.     Dim Findi As Integer
    
11.     Dim objShell, objFolder, objFolderItem, MyFile$, brr(20000, 200), n&
    
12.     Set objShell = CreateObject("shell.application")
    
13.         
    
14.                
    
15.    
    
16.     FileFormat = Application.InputBox("请输入即将被操作的文件格式")
    
17.     SearchPath = Application.InputBox("请输入目标路径，以\结尾", "提示")
    
18.    
    
19.     With fs
    
20.         .LookIn = SearchPath '设置搜索路径
    
21.         .FileName = "*." & FileFormat '要搜索文件名和类型
    
22.         .SearchSubFolders = True '是否需要搜索子文件 夹
    
23.         
    
24.         If .Execute > 0 Then '如果找到文件
    
25.             MsgBox "There were " & .FoundFiles.Count & " file(s) found." '显示找到多少个文件
    
26.             
    
27.             
    
28.             For i = 1 To .FoundFiles.Count
    
29.             
    
30.             
    
31.             
    
32.                 FileName = Fso.GetFileName(.FoundFiles(i)) '获得文件名
    
33.                 Filepath = Fso.GetParentFolderName(.FoundFiles(i))
    
34. 
    
35.                 Range("B" & (i + 1)) = FileName
    
36.                 Range("A" & (i + 1)) = Filepath & "" & FileName
    
37.                
    
38.                
    
39.                  '---------------------------------------------------------------------------------------------
    
40.                 objFolder = Filepath
    
41.                 MyFile = Dir(objFolder & "\*.mp4")
    
42.                 Set objFolder = objShell.Namespace(objFolder)
    
43.                
    
44.                 Do While MyFile <> ""
    
45.                    Set objFolderItem = objFolder.ParseName(MyFile)
    
46.                    If n = 0 Then
    
47.                       For k = 0 To UBound(brr, 2)
    
48.                           brr(0, k) = objFolder.GetDetailsOf(0, k)
    
49.                           n = 1
    
50.                           brr(n, 0) = MyFile
    
51.                           brr(n, k) = objFolder.GetDetailsOf(objFolderItem, k)
    
52.                       Next
    
53.                     Else
    
54.                       For k = 0 To UBound(brr, 2)
    
55.                           brr(n, 0) = MyFile
    
56.                           brr(n, k) = objFolder.GetDetailsOf(objFolderItem, k)
    
57.                       Next
    
58.                     End If
    
59.                     n = n + 1
    
60.                     MyFile = Dir
    
61.                 Loop
    
62. 
    
63.                 '-------------------------------------------------------------------------------------------------
    
64.         
    
65.                 Set objFolder = Nothing
    
66.             Next i
    
67.         Else
    
68.             MsgBox "There were no files found."
    
69.         End If
    
70.     End With
    
71. 
    
72.    
    
73.    
    
74.     Cells(1, 3).Resize(n + 1, UBound(brr, 2) + 1) = brr
    
75.     MsgBox "完成"
    
76. End Sub

复制代码

这是网上找的，自己进行了简单的拼接，但是始终是有问题，麻烦大大给个能用的，非常感谢

一把小刀闯天下

好好看一下里面是否有你需要的东西，如果有那就浏览你的所有mp4文件，使用二进制格式打开文件，然后根据偏移地址获取你所需要的数据段，，，然后就没有然后了

http://weiyinchao88.iteye.com/blog/1414290