使用 VBA 获取扩展文件属性

Using VBA to get extended file attributes

提问by Jim McKeeth

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):

尝试使用 Excel VBA 从磁盘上的文件中捕获所有文件属性，包括扩展属性。能够让它循环遍历文件并捕获基本属性（来自文件系统）：

• 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.

目标是创建文件服务器上所有文件的详细列表。

回答by Alex K.

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

你说 loop .. 所以如果你想为一个目录而不是当前文档做这个；

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;

其中 XXX 是属性列索引，例如 Author 为 9。要列出可用索引供您参考，您可以将 for 循环替换为；

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

回答by Todd Main

You can get this with .BuiltInDocmementProperties.

你可以用.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

有关您可以使用此访问的所有字段，请参阅此页面：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.

如果您尝试在客户端之外执行此操作（即关闭 Excel 并运行来自 .NET 程序的代码），则需要使用DSOFile.dll。

回答by Jorge Gudi?o

'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

回答by kdoske

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.

旧的投票代码不能在 Windows 10 系统上运行（至少不是我的）。下面引用的 MS 库链接提供了有关如何进行此工作的当前示例。我的示例将它们与后期绑定一起使用。

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

https://docs.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.

属性代码在我的电脑上是不同的，就像上面提到的人一样，大多数返回空白值，即使它们不是。我使用 for 循环遍历所有这些，发现仍然可以访问 Title 和 Subject，这对于我的目的来说已经足够了。

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