Using VBA to get extended file attributes

Trying to use Excel VBA to capture all the file attributes from files on disk, including extended attributes. Was able to get it to loop through the files and capture the basic attributes (that come from the file system):

• File Path
• File Name
• File Size
• Date Created
• Date Last Accessed
• Date Last Modified
• File Type

Would also like to capture the extended properties that come from the file itself:

• Author
• Keywords
• Comments
• Last Author
• Category
• Subject

And other properties which are visible when right clicking on the file.

The go开发者_高级运维al is to create a detailed list of all the files on a file server.

You say loop .. so if you want to do this for a dir instead of the current document;

Dim sFile As Variant
Dim oShell: Set oShell = CreateObject("Shell.Application")
Dim oDir:   Set oDir = oShell.Namespace("c:\foo")

For Each sFile In oDir.Items
   Debug.Print oDir.GetDetailsOf(sFile, XXX) 
Next

Where XXX is an attribute column index, 9 for Author for example. To list available indexes for your reference you can replace the for loop with;

for i = 0 To 40
   debug.? i, oDir.GetDetailsOf(oDir.Items, i)
Next

Quickly for a single file/attribute:

Const PROP_COMPUTER As Long = 56

With CreateObject("Shell.Application").Namespace("C:\HOSTDIRECTORY")
    MsgBox .GetDetailsOf(.Items.Item("FILE.NAME"), PROP_COMPUTER)
End With

You can get this with .BuiltInDocmementProperties.

For example:

Public Sub PrintDocumentProperties()
    Dim oApp As New Excel.Application
    Dim oWB As Workbook
    Set oWB = ActiveWorkbook

    Dim title As String
    title = oWB.BuiltinDocumentProperties("Title")

    Dim lastauthor As String
    lastauthor = oWB.BuiltinDocumentProperties("Last Author")

    Debug.Print title
    Debug.Print lastauthor
End Sub

See this page for all the fields you can access with this: http://msdn.microsoft.com/en-us/library/bb220896.aspx

If you're trying to do this outside of the client (i.e. with Excel closed and running code from, say, a .NET program), you need to use DSOFile.dll.

'vb.net
'Extended file stributes
'visual basic .net sample 

Dim sFile As Object
        Dim oShell = CreateObject("Shell.Application")
        Dim oDir = oShell.Namespace("c:\temp")

        For i = 0 To 34
            TextBox1.Text = TextBox1.Text & oDir.GetDetailsOf(oDir, i) & vbCrLf
            For Each sFile In oDir.Items
                TextBox1.Text = TextBox1.Text & oDir.GetDetailsOf(sFile, i) & vbCrLf
            Next
            TextBox1.Text = TextBox1.Text & vbCrLf
        Next

I was finally able to get this to work for my needs.

The old voted up code does not run on windows 10 system (at least not mine). The referenced MS library link below provides current examples on how to make this work. My example uses them with late bindings.

https://learn.microsoft.com/en-us/windows/win32/shell/folder-getdetailsof.

The attribute codes were different on my computer and like someone mentioned above most return blank values even if they are not. I used a for loop to cycle through all of them and found out that Title and Subject can still be accessed which is more then enough for my purposes.

Private Sub MySubNamek()
Dim objShell  As Object 'Shell
Dim objFolder As Object 'Folder

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace("E:\MyFolder")

If (Not objFolder Is Nothing) Then
Dim objFolderItem As Object 'FolderItem
Set objFolderItem = objFolder.ParseName("Myfilename.txt")
        For i = 0 To 288
           szItem = objFolder.GetDetailsOf(objFolderItem, i)
           Debug.Print i & " - " & szItem
       Next
Set objFolderItem = Nothing
End If

Set objFolder = Nothing
Set objShell = Nothing
End Sub

Lucky discovery

if objFolderItem is Nothing when you call

objFolder.GetDetailsOf(objFolderItem, i)

the string returned is the name of the property, rather than its (undefined) value e.g. when i=3 it returns "Date modified"

Doing it for all 288 values of I makes it clear why most cause it to return blank for most filetypes e.g i=175 is "Horizontal resolution"