修改文件属性的Excel VBA功能 [英] Modify Excel VBA Function for File Properties
问题描述
如何修改此代码以提供对象文件夹中每个文件的详细信息?
目前当我运行它时,我只是获取文件夹的详细信息,而不是文件夹中的文件。我需要的具体细节是所有者,作者,修改日期和名称。我不知道这是否可以在函数内完成,但我想超链接到实际文件的名称,所以我还需要名称的路径。
How can I modify this code to give details of each file in the object folder? Currently when I run it I just get the details of the folder and not the files in the folder. The specific details I need are the owner, author, date modified, and name. I don't know if this can be done within the function, but I would like to hyperlink to the name to the actual file so I would also need the name's 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
推荐答案
事实上,脚本专家具有您正在查找的代码:
In fact, The Scripting Guys have exactly the code you are looking for:
Set objFile = CreateObject("DSOFile.OleDocumentProperties")
objFile.Open("C:\Scripts\New_users.xls")
Debug.Print "Author: " & objFile.SummaryProperties.Author
即使这不需要添加对DSOFile.dll的引用,它也可以要求安装它,以便您的工作簿仍然不够便携。您可以添加一个查找DSOFile.dll的函数,如果找不到它,将用户导向下载页面。
Even though this does not require adding a reference to DSOFile.dll, it does require that it be installed so your workbook is still not very portable. You could add a function that looks for DSOFile.dll and directs the user to the download page if it is not found.
我仍然会推荐这样的后期绑定,因为您不应该以这种方式遇到任何版本依赖关系。如果您专门添加了对DSOFile.dll的引用,并且出现了一个新版本,它可能并不具有完全相同的名称,然后您的代码会中断。
I would still recommend late binding like this because you shouldn't run into any version dependencies this way. If you specifically add a reference to DSOFile.dll and a new version comes out, it may not have exactly the same name and then your code breaks.
当然,我会建议在第一次编写代码时最初添加一个引用,以便您可以利用Intellisense,但一定要更改它会在您的代码写入后延迟绑定。
Of course, I would recommend initially adding a reference when first writing the code so you can take advantage of Intellisense, but make sure to change it to late binding once your code is written.
早期绑定:
Early binding:
Dim objFile As New DSOFile.OleDocumentProperties
objFile.Open("C:\Scripts\New_users.xls")
然后将其更改为Late绑定:
Then change it to Late binding:
Dim objFile As Object 'New DSOFile.OleDocumentProperties
Set objFile = CreateObject("DSOFile.OleDocumentProperties")
objFile.Open("C:\Scripts\New_users.xls")
这篇关于修改文件属性的Excel VBA功能的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!