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的引用并且出现了新版本，则它可能不具有完全相同的名称，然后您的代码中断。

当然，我建议在第一次编写代码时首先添加引用，以便您可以利用Intellisense，但一旦编写代码，请确保将其更改为后期绑定。

早期绑定：

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

然后将其更改为Late binding：

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

修改文件属性的Excel VBA功能

1 个答案: