Изменение функции Excel VBA для свойств файла

Question

Как я могу изменить этот код, чтобы предоставить подробную информацию о каждом файле в папке объекта? В настоящее время, когда я запускаю его, я просто получаю детали папки, а не файлы в папке. Конкретные детали, которые мне нужны, это владелец, автор, дата и дата. Я не знаю, может ли это быть сделано внутри функции, но я бы хотел связать имя с фактическим файлом, поэтому мне также понадобится путь имени.

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 

    ' If the file does not exist then quit out 
    If Dir(strFilePath) = "" Then Exit Function 

    ' Parse the file name out from the folder path 
    strFileName = strFilePath 
    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 

      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

В самом деле, The Scripting Guys имеют именно код, который вы ищете:

Set objFile = CreateObject("DSOFile.OleDocumentProperties") 
objFile.Open("C:\Scripts\New_users.xls") 
Debug.Print "Author: " & objFile.SummaryProperties.Author 

Даже если это не требует добавления ссылки на DSOFile.dll, она требует, чтобы он был установлен таким образом, ваш книга по-прежнему не очень переносима. Вы можете добавить функцию, которая ищет DSOFile.dll, и направляет пользователя на страницу загрузки, если она не найдена.

Я бы порекомендовал позднюю привязку как это, потому что вы не должны столкнуться с какими-либо зависимостями в версии таким образом. Если вы специально добавите ссылку на DSOFile.dll и выйдет новая версия, у нее может быть не одно и то же имя, а затем ваш код разрывается.

Конечно, I будет рекомендовать сначала добавлять ссылку при первом написании кода, чтобы вы могли использовать Intellisense, но не забудьте изменить его на позднее связывание после написания вашего кода.

Раннее связывание:

Dim objFile As New DSOFile.OleDocumentProperties 
objFile.Open("C:\Scripts\New_users.xls") 

Затем измените его до позднего связывания:

Dim objFile As Object 'New DSOFile.OleDocumentProperties 
Set objFile = CreateObject("DSOFile.OleDocumentProperties") 
objFile.Open("C:\Scripts\New_users.xls")