Retrieving file information via Excel VBA

Question

I'm trying to extract certain file characteristics (specifically size in bytes and length of video) and putting that information into a spreadsheet along with the file name and its path including subdirectories. I've got it working about 90% but I'm stumbling on one point-retrieving the video length.

In the spread sheet I enter the full path name I want to start at in B2. That object in A2 is actually a control that executes the macro:

Sub loopAllSubFolderSelectStartDirectory()

In one of my sub procedures (LoopAllSubFolders) I have these two lines:

        VideoLength = Get\_Extended\_File\_Info(fullFilePath, FileName, 27) 

        SizeinBytes = GetDirOrFileSize(folderPath, FileName) 

The size in bytes works but the video length fails. I know this because the macro executes successfully (albeit without the video length) if I comment out the call to the video length function.

Executing the video length functions results in the following debug error:

In searching the internet and this community found solutions for retrieving this information. They differ slightly.

If I execute the video length function I get the following debug error:

[I've bolded the line debug stops at]

Function Get_Extended_File_Info(strPath As Variant, strFile As String, Optional PropNum As Integer = 3) As String

' Length of video

Dim sFile, oDir, obja As Object 

'Create Shell Object & NameSpace 

**Set oDir = CreateObject("Shell.Application").Namespace(strPath)** 

Set sFile = oDir.ParseName(strFile)

I know I'm just overlooking something very basic, but it has me pulling my hair out. Also, in my searching I could not find an exact duplicate of the function that retrieves the size in bytes that would retrieve the video length. My preferred approach would be to just tweak the function that retrieves the size in bytes so that it retrieves the video length.

I know the information I have provided thus is lacking in sufficient detail to arrive at a solution. However, I can't figure out how to upload my actual spreadsheet so that you can see it and the VBA code attached to it.

Baring that, I've pasted all of the VBA code here. I've bolded the start of each sub/function hoping that makes it a little easier to read.

Option Explicit

Dim RowIndex As Integer

Sub loopAllSubFolderSelectStartDirectory()

' loop through subfolders

Dim StartFolder As String

StartFolder = Cells(1, 2).Value

RowIndex = 4

' Clear previous entry

Rows("4:4").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.ClearContents

Range("A1").Select

Call LoopAllSubFolders(StartFolder)

Columns("C:C").EntireColumn.AutoFit

' Parse file names into columns

Range("D4").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.TextToColumns Destination:=Range("D4"), DataType:=xlDelimited, _

TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, \_ 

Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar \_ 

:="\", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), \_ 

TrailingMinusNumbers:=True 

Range("A1").Select

End Sub

Sub LoopAllSubFolders(ByVal folderPath As String)

Dim FileName As String

Dim fullFilePath As Variant

Dim numFolders As Long

Dim SizeinBytes As Long

Dim VideoLength As String

Dim folders() As String

Dim i As Long

If Right(folderPath, 1) <> "" Then folderPath = folderPath & ""

FileName = Dir(folderPath & "*.*", vbDirectory)

While Len(FileName) <> 0

If Left(FileName, 1) <> "." Then 

    fullFilePath = folderPath & FileName 

    If (GetAttr(fullFilePath) And vbDirectory) = vbDirectory Then 

        ReDim Preserve folders(0 To numFolders) As String 

        folders(numFolders) = fullFilePath 

        numFolders = numFolders + 1 

    Else 

' VideoLength = Get_Extended_File_Info(fullFilePath, FileName, 27)

        VideoLength = Get\_Extended\_File\_Info(folderPath, FileName, 27) 

        SizeinBytes = GetDirOrFileSize(folderPath, FileName) 

        Cells(RowIndex, 1) = VideoLength 

        Cells(RowIndex, 2) = SizeinBytes 

        Cells(RowIndex, 3) = FileName 

        Cells(RowIndex, 4) = folderPath 

        RowIndex = RowIndex + 1 

    End If 

End If 

FileName = Dir() 

Wend

For i = 0 To numFolders - 1

LoopAllSubFolders folders(i) 

Next i

End Sub

Function GetDirOrFileSize(strFolder As String, Optional strFile As Variant) As Long

' Get file size in bytes

Dim lngFSize As Long, lngDSize As Long

Dim oFO As Object

Dim oFD As Object

Dim OFS As Object

lngFSize = 0

Set OFS = CreateObject("Scripting.FileSystemObject")

If strFolder = "" Then strFolder = ActiveWorkbook.Path

If Right(strFolder, 1) <> "" Then strFolder = strFolder & ""

If OFS.FolderExists(strFolder) Then

 If Not IsMissing(strFile) Then 

   If OFS.FileExists(strFolder & strFile) Then 

     Set oFO = OFS.Getfile(strFolder & strFile) 

     GetDirOrFileSize = oFO.Size 

   End If 

   Else 

    Set oFD = OFS.GetFolder(strFolder) 

    GetDirOrFileSize = oFD.Size 

   End If 

End If

End Function

Function Get_Extended_File_Info(strPath As Variant, strFile As String, Optional PropNum As Integer = 3) As String

' Length of video

Dim sFile, oDir, obja As Object 

'Create Shell Object & NameSpace 

Set oDir = CreateObject("Shell.Application").Namespace(strPath) 

Set sFile = oDir.ParseName(strFile) 

        obja = oDir.GetDetailsOf(sFile, PropNum) 

        If obja <> "" Then 

             obja = Replace(obja, ChrW(8206), "") 

             obja = Replace(obja, ChrW(8207), "") 

            Get\_Extended\_File\_Info = obja 

Set oDir = Nothing

            Exit Function 

        End If 

Set oDir = Nothing

End Function

Answer 1

Hi Norman Martens1,

Welcome to the Microsoft community.

The error you're encountering, "Method 'NameSpace' of object 'IShellDispatch6' failed," typically indicates that the strPath variable being passed to the Namespace method either does not represent a valid directory path or there's an issue with the way paths are handled, especially when dealing with special characters or unconventional paths.

I refine the Get_Extended_File_Info function to better handle potential path issues and debug the process. I'll add error handling to identify any problematic paths and ensure paths are formatted correctly before passing them to the Shell object:

Function Get_Extended_File_Info(strPath As Variant, strFile As String, Optional PropNum As Integer = 3) As String 

    ' Length of video 

    Dim sFile, oDir, obja As Object 

    Dim strValidPath As String 

    ' Ensure the path ends with a backslash if it doesn't already 

    If Right(strPath, 1) <> "\" Then strPath = strPath & "\" 

    ' Debugging: Check if the path exists before attempting to create Shell object 

    If Not FolderExists(strPath) Then 

        MsgBox "The path '" & strPath & "' does not exist.", vbCritical, "Invalid Path" 

        Get_Extended_File_Info = "Error: Path Not Found" 

        Exit Function 

    End If 

    ' Attempt to Create Shell Object & NameSpace with proper error handling 

    On Error Resume Next 

    Set oDir = CreateObject("Shell.Application").Namespace(strPath) 

    If Err.Number <> 0 Then 

        MsgBox "Error accessing the path '" & strPath & "'. Error: " & Err.Description, vbCritical, "Shell Namespace Error" 

        Err.Clear 

        Get_Extended_File_Info = "Error: Access Denied or Invalid Path" 

        Exit Function 

    End If 

    On Error GoTo 0 

    ' Continue as before... 

    Set sFile = oDir.ParseName(strFile) 

    obja = oDir.GetDetailsOf(sFile, PropNum) 

    If obja <> "" Then 

        obja = Replace(obja, ChrW(8206), "")  

        obja = Replace(obja, ChrW(8207), "")  

        Get_Extended_File_Info = obja 

    Else 

        Get_Extended_File_Info = "N/A" 

    End If 

    Set oDir = Nothing 

End Function 

' Helper Function to check if a folder exists 

Function FolderExists(path As String) As Boolean 

    FolderExists = Dir(path, vbDirectory) <> "" 

End Function 

In the updated code, I've added:

• Path Validation: Ensuring the path ends with a backslash to avoid path resolution issues.
• Debugging Message: A message box alerts users when the specified path doesn't exist, which could be the source of the error.
• Error Handling: Around the creation of the Shell object to catch any exceptions and provide a more informative error message.

With these modifications, you should be able to identify if the problem lies in the path being invalid or inaccessible to the Shell object. I recommend to test different paths to further isolate the issue, ensuring they are accessible and correctly formatted.

Please feel free to tell if these code help.

Best Regards,

Jonathan Z - MSFT | Microsoft Community Support Specialist

Answer 2

If CreateObject("Shell.Application").Namespace(strPath)

no work.

Try .bat methods.

Download console tool:

https://filetransfer.io/data-package/lsmAOGs6#link

command line:

d:\mp4inf.exe yourMp4.mp4

will return the length in seconds.

Answer 3

I replaced my old function with yours. Things were looking up until I got the line:

 Set sFile = oDir.ParseName(strFile) 

where I got this message:

The value of strFile is "c130 drop.MP4".

Because I've had issues with spaces in folder/file names before I changed it to remove the space but got the same error.

Answer 4

I'm not familiar with the tool. Can it also retrieve other file attributes like size (in bytes), date created, etc?

Thanks.

Answer 5

No,only play time in seconds.

I compiled it from below.

https://www.cnblogs.com/Akkuman/p/12371838.html

I guess dir and file.system.object can get size and create time.

C:\test>dir /x

Volume in drive C has no label.

Volume Serial Number is B86A-EF32

Directory of C:\test

11/30/2004 01:40 PM <DIR> .

11/30/2004 01:40 PM <DIR> ..

11/30/2004 11:05 AM 0 T97B4~1.TXT t.txt2

11/30/2004 01:16 PM 0 t97.txt

if.possible share a mp4.