修改文件属性的Excel VBAfunction

如何修改此代码以提供对象文件夹中每个文件的详细信息？ 目前，当我运行它时，我只是获取文件夹的详细信息，而不是文件夹中的文件。 我需要的具体细节是所有者，作者，修改date和名称。 我不知道这是否可以在函数内完成，但我想超链接到实际文件的名称，所以我也需要名称的path。

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

实际上， 脚本专家具有您正在查找的代码：

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

尽pipe这不需要添加对DSOFile.dll的引用，但它确实需要安装，因此您的工作簿仍然不够便携。 您可以添加一个查找DSOFile.dll的函数，如果找不到，可以将用户导向下载页面。

我仍然build议像这样的后期绑定，因为你不应该遇到任何版本依赖这种方式。 如果您专门添加了对DSOFile.dll的引用，并且出现了新的版本，则可能不会有完全相同的名称，然后您的代码会中断。

当然，我会build议在第一次编写代码时添加一个引用，这样您就可以利用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")