Использование VBA для получения расширенных атрибутов файла

Попытка использовать Excel VBA для захвата всех атрибутов файла из файлов на диске, включая расширенные атрибуты. Он смог заставить его зациклиться на файлах и захватить основные атрибуты (которые поступают из файловой системы):

  • Путь к файлу
  • Имя файла
  • Размер файла
  • Дата создания
  • Дата последнего доступа
  • Дата последнего изменения.
  • Тип файла

Также хотелось бы захватить расширенные свойства, которые поступают из самого файла:

  • Автор
  • Ключевые слова
  • Комментарии
  • Последний автор
  • Категория
  • Тема

И другие свойства, которые видны при щелчке правой кнопкой мыши по файлу.

Цель состоит в том, чтобы создать подробный список всех файлов на файловом сервере.

Ответы

Ответ 1

Вы говорите, что цикл... так что если вы хотите сделать это для dir вместо текущего документа;

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

Где XXX - индекс столбца атрибута, например 9 для автора. Чтобы перечислить доступные индексы для вашей справки, вы можете заменить цикл for на;

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

Быстро для одного файла/атрибута:

Const PROP_COMPUTER As Long = 56

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

Ответ 2

Вы можете получить это с помощью .BuiltInDocmementProperties.

Например:

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

Смотрите эту страницу для всех полей, к которым вы можете получить доступ: http://msdn.microsoft.com/en-us/library/bb220896.aspx

Если вы пытаетесь сделать это за пределами клиента (например, с закрытым и выполняемым кодом Excel, скажем, с помощью .NET-программы), вам нужно использовать DSOFile.dll.

Ответ 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

Ответ 4

Я наконец смог заставить это работать, используя позднюю привязку и ссылку на эту ссылку: https://docs.microsoft.com/en-us/windows/win32/shell/folder-getdetailsof. Коды атрибутов были разными на моем компьютере и, как кто-то из упомянутых выше, большинство возвращали пустые значения, даже если это не так. Я использовал цикл for для их циклического просмотра и обнаружил, что к заголовку и теме все еще можно получить доступ, чего более чем достаточно для моих целей.

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