Retrieving file information via Excel VBA

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) &lt;&gt; "." 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 &lt;&gt; "" 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

Share via

Retrieving file information via Excel VBA

6 answers