Using VBA to get extended file attributes
Asked Answered
C

5

26

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 goal is to create a detailed list of all the files on a file server.

Cradling answered 13/4, 2011 at 15:39 Comment(0)
C
28

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
Continually answered 13/4, 2011 at 16:20 Comment(4)
Also See Microsoft site: technet.microsoft.com/en-us/library/ee176615.aspxOuellette
For those directed here this is out of date a bit. There are now 288 attributes you can use. For example, file version 271. Update the for loop to see them all. msdn.microsoft.com/en-us/library/windows/desktop/…Hun
Further update: As of sometime this past summer (2017) all indices above 6 are invalid, returning only empty strings.Isoagglutination
The above statement returning only empty strings is incorrect. I placed something in the keywords property (it's "Labels" in Dutch, think it's the same) and found it at index 18.Leilani
R
8

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.

Reward answered 13/4, 2011 at 15:57 Comment(3)
My question wasn't very clear. I am trying to capture file attributes from files on disk. This looks like it is reading the properties from the open document. How would I get the properties from a file on disk?Cradling
Ah, it was tagged Excel-VBA, so I thought you wanted to do this from inside the client. For outside the client (i.e. reading from disk), you would use DSOFile.dll (the last paragraph in my answer).Reward
Changed the tags as this has nothing to do with Excel.Reward
D
4

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
Dollar answered 1/10, 2019 at 19:41 Comment(3)
There are other answers that provide the OP's question, and they were posted some time ago. When posting an answer, please make sure you add either a new solution, or a substantially better explanation, especially when answering older questions.Bourgeoisie
Ok, I thought I was clear. The old voted up code does not run on windows 10 system (at least not mine). The referenced MS library link mentioned above provides current examples on how to make this work. My example uses them with late bindings.Dollar
Please check my edit - so, we should delete our comments for clean up.Bourgeoisie
P
3
'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
Pasquinade answered 2/6, 2016 at 17:5 Comment(0)
R
3

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"

Ruffin answered 5/6, 2020 at 21:1 Comment(1)
please elaborateNominal

© 2022 - 2024 — McMap. All rights reserved.