Getting Consistent FOLDER Attributes With VBA

Question

I have been using the code below for years to grab file attributes using VBA.  Works just fine.  However, when I try to grab the same attributes for FOLDERS, the code does not work consistently.  It seems that the attributes for FOLDERS can vary from folder to folder, so that the attribute "Owner", for example, is not always in the number 10 slot in the array of attributes.  When I print the list of attributes for a folder (from 0 to 255), "Owner" can be anywhere in that list.

Does anyone understand why this is happening, and how I can consistently extract FOLDER details just as I do for FILES?

For example:

"C:\Users\thisUser\thisFolder\myfile.xlsx" returns correct attributes for file "myfile.xlsx"

"C:\Users\thisUser\thisFolder" returns incorrect attributes for folder "thisFolder"

Running Excel 2007, Windows 7

Thanks,

Eric

Option Explicit

Type FileAttributes

    Name As String

    Size As String

    FileType As String

    DateModified As Date

    DateCreated As Date

    DateAccessed As Date

    Attributes As String

    Status As String

    Owner As String

    Author As String

    Title As String

    Subject As String

    Category As String

    Comments As String

    Keywords As String

End Type

Public Function GetFileAttributes(strFilePath As String) As FileAttributes

     ' Shell32 objects

    Dim objShell As Shell32.Shell

    Dim objFolder As Shell32.Folder

    Dim objFolderItem As Shell32.FolderItem

     ' Other objects

    Dim strPath As String

    Dim strFileName As String

    Dim i As Integer

    Dim itsaFolder As Boolean

'

On Error GoTo 0

'

    If (Right(strFilePath, 1) = "") Then   ' This is a folder, not a file

        itsaFolder = True

    Else

        itsaFolder = False

    End If

     ' If the file does not exist then quit out

    If ((itsaFolder And Dir(strFilePath & "") = "") Or _

        (Not itsaFolder And Dir(strFilePath) = "")) Then Exit Function

     ' Parse the file name out from the folder path

    If (itsaFolder) Then

        strFileName = Left(strFilePath, Len(strFilePath) - 1)

    Else

        strFileName = strFilePath

    End If

    i = 1

    Do Until i = 0

        i = InStr(1, strFileName, "", vbBinaryCompare)

        strFileName = Mid(strFileName, i + 1)

    Loop

    strPath = Left(strFilePath, Len(strFilePath) - Len(strFileName) - 1)

     ' Set up the shell32 Shell object

    Set objShell = New Shell

     ' Set the shell32 folder object

    Set objFolder = objShell.Namespace(strPath)

     ' If we can find the folder then ...

    If (Not objFolder Is Nothing) Then

         ' Set the shell32 file object

        Set objFolderItem = objFolder.ParseName(strFileName)

         ' If we can find the file then get the file attributes

        If (Not objFolderItem Is Nothing) Then

'For testing only, to print list of attribute names:

'For i = 0 To 255

'    Debug.Print i, objFolder.GetDetailsOf(objFolder.Items, i), objFolder.GetDetailsOf(objFolderItem, i)

'Next i

            GetFileAttributes.Name = objFolder.GetDetailsOf(objFolderItem, 0)

            GetFileAttributes.Size = objFolder.GetDetailsOf(objFolderItem, 1)

            GetFileAttributes.FileType = objFolder.GetDetailsOf(objFolderItem, 2)

            GetFileAttributes.DateModified = CDate(objFolder.GetDetailsOf(objFolderItem, 3))

            GetFileAttributes.DateCreated = CDate(objFolder.GetDetailsOf(objFolderItem, 4))

            GetFileAttributes.DateAccessed = CDate(objFolder.GetDetailsOf(objFolderItem, 5))

            GetFileAttributes.Attributes = objFolder.GetDetailsOf(objFolderItem, 6)

            GetFileAttributes.Status = objFolder.GetDetailsOf(objFolderItem, 7)

            GetFileAttributes.Owner = objFolder.GetDetailsOf(objFolderItem, 8)

            GetFileAttributes.Author = objFolder.GetDetailsOf(objFolderItem, 9)

            GetFileAttributes.Title = objFolder.GetDetailsOf(objFolderItem, 10)

            GetFileAttributes.Subject = objFolder.GetDetailsOf(objFolderItem, 11)

            GetFileAttributes.Category = objFolder.GetDetailsOf(objFolderItem, 12)

            GetFileAttributes.Comments = objFolder.GetDetailsOf(objFolderItem, 14)

            GetFileAttributes.Keywords = objFolder.GetDetailsOf(objFolderItem, 40)

        End If

        Set objFolderItem = Nothing

    End If

    Set objFolder = Nothing

    Set objShell = Nothing

End Function

Answer 1

You're lucky that it worked for you, the most results of this code is wrong on my PC.

If you read the description of the MSDN article to GetDetailsOf, you can see why it does not provide generalizable results.

http://msdn.microsoft.com/en-us/library/windows/desktop/bb787870%28v=vs.85%29.aspx

No chance, sorry.

Andreas.

Answer 2

Thanks for responding, Andreas.  I found a way around this that worked in my specific case, but you are correct - this capability is not consistent and cannot be relied on to always give the same results.

Eric