VBA填充上次保存的用户和上次保存的文件日期
Posted
tags:
篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了VBA填充上次保存的用户和上次保存的文件日期相关的知识,希望对你有一定的参考价值。
我一直在使用下面的代码从文件夹中获取文件名,但是我需要进行微调。我需要添加以获取以下内容并在电子表格中填充它:
- 文件最后更新者(列O)
- 文件上次更新日期(P列)
- 将文件超链接到电子表格(第Q列)
有人可以帮助我更新此代码以包含这些吗?
码:
Sub GetFileNames_Assessed_As_T2()
Dim sPath As String, sFile As String
Dim iRow As Long, iCol As Long
Dim ws As Worksheet: Set ws = Sheet9
'declare and set the worksheet you are working with, amend as required
sPath = "Z:NAMET2"
'specify directory to use - must end in ""
sFile = Dir(sPath)
Do While sFile <> ""
LastRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row 'get last row on Column I
Filename = Left(sFile, InStrRev(sFile, ".") - 1) 'remove extension from file
Set FoundFile = ws.Range("I1:I" & LastRow).Find(what:=Filename, lookat:=xlWhole) 'search for existing filename
If FoundFile Is Nothing Then ws.Cells(LastRow + 1, "I") = Filename 'if not found then add it
sFile = Dir ' Get next filename
Loop
End Sub
答案
以下是通过Dsofile.dll访问扩展文档属性的示例。 32位版本是here。我正在使用robert8w8重写的64位替代方案。在我的情况下安装64位版本后,你去工具>参考>添加对DSO OLE Document Properties Reader 2.1
的引用。它可以访问已关闭文件的扩展属性。显然,如果信息不可用,则无法返回。
我有一个可选的文件掩码测试,可以删除。
DSO函数是我重写的一个很好的子函数,它列出了xld here的更多属性。
Option Explicit
Public Sub GetLastestDateFile()
Dim FileSys As Object, objFile As Object, myFolder As Object
Const myDir As String = "C:UsersUserDesktopTestFolder" '< Pass in your folder path
Set FileSys = CreateObject("Scripting.FileSystemObject")
Set myFolder = FileSys.GetFolder(myDir)
Dim fileName As String, lastRow As Long, arr(), counter As Long
With ThisWorkbook.Worksheets("Sheet1") '<== Change to your sheet where writing info to
lastRow = .Cells(.Rows.Count, "P").End(xlUp).Row 'find the last row with data in P
For Each objFile In myFolder.Files 'loop files in folder
fileName = objFile.Path
If FileSys.GetExtensionName(fileName) = "xlsx" Then 'check if .xlsx
arr = GetExtendedProperties(fileName)
counter = counter + 1
.Cells(lastRow + counter, "O") = arr(0) 'Last updated
.Cells(lastRow + counter, "P") = arr(1) 'Last save date
.Hyperlinks.Add Anchor:=.Cells(lastRow + counter, "Q"), Address:=objFile.Path '<== Add hyperlink
End If
Next objFile
End With
End Sub
Public Function GetExtendedProperties(ByVal FileName As String) As Variant
Dim fOpenReadOnly As Boolean, DSO As DSOFile.OleDocumentProperties
Dim oSummProps As DSOFile.SummaryProperties, oCustProp As DSOFile.CustomProperty
Dim outputArr(0 To 1)
Set DSO = New DSOFile.OleDocumentProperties
DSO.Open FileName, fOpenReadOnly, dsoOptionOpenReadOnlyIfNoWriteAccess
Set oSummProps = DSO.SummaryProperties
outputArr(0) = oSummProps.LastSavedBy
outputArr(1) = oSummProps.DateLastSaved
GetExtendedProperties = outputArr
End Function
其他:
以上是关于VBA填充上次保存的用户和上次保存的文件日期的主要内容,如果未能解决你的问题,请参考以下文章
使用 Firebase 3 从 FIRUser 获取创建日期和上次登录日期