Solved: FSO Function to get Datelastmodified, DateLastAccessed

[xluser2007]

Hi All,

Is there a FSO based UDF to display the:

- date last accessed
- date last modified
- owner
- author

If the function takes an input string of a filename e.g. "C:\learnformulas\challenge.xls"

Any help appreciated.

regards

[Zack Barresse]

Hi there,

The first two can be accessed with a file scripting object, and the last one can be obtained from the built in properties of a file. The owner is the tricky one. This may be quite expensive, and should not be used on a worksheet function, only from VBA (way too expensive for that)...
Sub testroutinenowplease1()
MsgBox GetFileAttribute("Date last accessed", "C:\path\file.xls")
End Sub

Sub testroutinenowplease2()
MsgBox GetFileAttribute("Date last modified", "C:\path\file.xls")
End Sub

Sub testroutinenowplease3()
MsgBox GetFileAttribute("author", "C:\path\file.xls")
End Sub

Sub testroutinenowplease4()
MsgBox GetFileAttribute("author", "C:\path\file.xls")
End Sub

Function GetFileAttribute(vAttrib As Variant, sFullName As String) As String
Dim FSO As Scripting.FileSystemObject, fsoFile As Scripting.File
Dim objShell As Object, objFolder As Object, objFolderItem As Object
Dim wkbTemp As Workbook, blnOpen As Boolean
Dim sName As String, sPath As String
Set FSO = New Scripting.FileSystemObject
sName = Right(sFullName, Len(sFullName) - InStrRev(sFullName, Application.PathSeparator))
sPath = Left(sFullName, InStrRev(sFullName, Application.PathSeparator))
Select Case UCase(vAttrib)
Case "DATE LAST ACCESSED"
GetFileAttribute = FSO.GetFile(sFullName).DateLastAccessed
Case "DATE LAST MODIFIED"
GetFileAttribute = FSO.GetFile(sFullName).DateLastModified
Case "OWNER"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(sPath)
Set objFolderItem = objFolder.ParseName(sFullName)
GetFileAttribute = objFolder.GetDetailsOf(objFolderItem, 8)
Case "AUTHOR"
If WBOPEN(sName) = True Then
Set wkbTemp = Workbooks(sName)
blnOpen = True
Else
Set wkbTemp = Workbooks.Open(Filename:=sFullName, UpdateLinks:=False, ReadOnly:=True)
blnOpen = False
End If
GetFileAttribute = wkbTemp.BuiltinDocumentProperties("Author")
If blnOpen = False Then wkbTemp.Close False
Case Else
GetFileAttribute = "None"
End Select
End Function

Function WBOPEN(wbName As String) As Boolean
On Error Resume Next
WBOPEN = Len(Workbooks(wbName).Name)
End Function

HTH

[xluser2007]

Hi there,

Sub testroutinenowplease1()
MsgBox GetFileAttribute("Date last accessed", "C:\path\file.xls")
End Sub

Sub testroutinenowplease2()
MsgBox GetFileAttribute("Date last modified", "C:\path\file.xls")
End Sub

Sub testroutinenowplease3()
MsgBox GetFileAttribute("author", "C:\path\file.xls")
End Sub

Sub testroutinenowplease4()
MsgBox GetFileAttribute("author", "C:\path\file.xls")
End Sub

Function GetFileAttribute(vAttrib As Variant, sFullName As String) As String
Dim FSO As Scripting.FileSystemObject, fsoFile As Scripting.File
Dim objShell As Object, objFolder As Object, objFolderItem As Object
Dim wkbTemp As Workbook, blnOpen As Boolean
Dim sName As String, sPath As String
Set FSO = New Scripting.FileSystemObject
sName = Right(sFullName, Len(sFullName) - InStrRev(sFullName, Application.PathSeparator))
sPath = Left(sFullName, InStrRev(sFullName, Application.PathSeparator))
Select Case UCase(vAttrib)
Case "DATE LAST ACCESSED"
GetFileAttribute = FSO.GetFile(sFullName).DateLastAccessed
Case "DATE LAST MODIFIED"
GetFileAttribute = FSO.GetFile(sFullName).DateLastModified
Case "OWNER"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(sPath)
Set objFolderItem = objFolder.ParseName(sFullName)
GetFileAttribute = objFolder.GetDetailsOf(objFolderItem, 8)
Case "AUTHOR"
If WBOPEN(sName) = True Then
Set wkbTemp = Workbooks(sName)
blnOpen = True
Else
Set wkbTemp = Workbooks.Open(Filename:=sFullName, UpdateLinks:=False, ReadOnly:=True)
blnOpen = False
End If
GetFileAttribute = wkbTemp.BuiltinDocumentProperties("Author")
If blnOpen = False Then wkbTemp.Close False
Case Else
GetFileAttribute = "None"
End Select
End Function

Function WBOPEN(wbName As String) As Boolean
On Error Resume Next
WBOPEN = Len(Workbooks(wbName).Name)
End Function
HTH
Hi Zack many thanks for your kind efforts, much appreciated.

I have tested and they work well indeed!

I have 2 queries though:

1. The "Owner" field that i was after is more the person who last modified the document. Your macro searches and finds the "author", who is the person that originally created the document. is it possible to find teh owner using your function?


The first two can be accessed with a file scripting object, and the last one can be obtained from the built in properties of a file. The owner is the tricky one. This may be quite expensive, and should not be used on a worksheet function, only from VBA (way too expensive for that)...
2. Interesting, as the author takes a while to obtain (I'm sure the owner would take a similarly long time). I am actually intending to use this as a WorkSheetfunction though, there should be about 100 of these foumulas potentially used, any ideas on what i should do to minimise calculation time?

Thanks again for your help Zack.

regards

[xluser2007]

Hi Zack,

sorry, I realised you had amade a provision for "owner", but when I tested it as follows:

Sub testroutinenowplease4()
MsgBox GetFileAttribute("owner", "D:\VBAX\VBAtutorial.xls")
End Sub

It pops up with a

Runtime error 91: Object variable or with block variable not set

and highlights the line:

Set objFolderItem = objFolder.ParseName(sFullName)

Could you please explain how to correct for this. I would still like to get your thoughts on query #2 above, once this is issue is corrected for.

thanks and regards,

[Kenneth Hobs]

I have not tested Zack's code.

xluser2007, I recommend that you do not request FSO methods for solutions. Instead, ask for a solution based on your goals.

My solution and other file property solutions that you might want were discussed in this thread: http://www.mrexcel.com/forum/showthread.php?t=361908

Here is my approach using a UDF method. I did not use:
Application.Volatile True It would be needed if you want to update UDF's if a cell value is manually changed. It is best to avoid it if you can.

'http://www.microsoft.com/technet/scriptcenter/resources/qanda/oct04/hey1007.mspx
Function FileOwner(strFile) As String
Dim strComputer As String
Dim objWMIService As Object
Dim colItems As Object
Dim objItem As Variant
'Application.Volatile True
On Error Resume Next

strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colItems = objWMIService.ExecQuery _
("ASSOCIATORS OF {Win32_LogicalFileSecuritySetting='" & strFile & "'}" _
& " WHERE AssocClass=Win32_LogicalFileOwner ResultRole=Owner")

For Each objItem In colItems
'FileOwner = objItem.ReferencedDomainName
FileOwner = objItem.AccountName
Next
End Function

Function FileDateLastAccessed(strFile) As Date
FileDateLastAccessed = CreateObject("Scripting.FileSystemObject").GetFile(strFile).DateLastAccessed
End Function

Function FileDateLastModified(strFile) As Date
FileDateLastModified = CreateObject("Scripting.FileSystemObject").GetFile(strFile).DateLastModified
End Function

[xluser2007]

I have not tested Zack's code.

xluser2007, I recommend that you do not request FSO methods for solutions. Instead, ask for a solution based on your goals.

My solution and other file property solutions that you might want were discussed in this thread: http://www.mrexcel.com/forum/showthread.php?t=361908



Hi kenneth, thanks heaps for your efforts, I appreciate it. The reason why I requested FSO was because I remembered seeing someone at work use it a while back and thought it was optimal, but I realise to ask more directly a solution to my query than a specific method (which may not be best) :).


Here is my approach using a UDF method. I did not use:
Application.Volatile True It would be needed if you want to update UDF's if a cell value is manually changed. It is best to avoid it if you can.

'http://www.microsoft.com/technet/scriptcenter/resources/qanda/oct04/hey1007.mspx
Function FileOwner(strFile) As String
Dim strComputer As String
Dim objWMIService As Object
Dim colItems As Object
Dim objItem As Variant
'Application.Volatile True
On Error Resume Next

strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colItems = objWMIService.ExecQuery _
("ASSOCIATORS OF {Win32_LogicalFileSecuritySetting='" & strFile & "'}" _
& " WHERE AssocClass=Win32_LogicalFileOwner ResultRole=Owner")

For Each objItem In colItems
'FileOwner = objItem.ReferencedDomainName
FileOwner = objItem.AccountName
Next
End Function

Function FileDateLastAccessed(strFile) As Date
FileDateLastAccessed = CreateObject("Scripting.FileSystemObject").GetFile(strFile).DateLastAccessed
End Function

Function FileDateLastModified(strFile) As Date
FileDateLastModified = CreateObject("Scripting.FileSystemObject").GetFile(strFile).DateLastModified
End Function

I just tested and it works great in VBA, though the fileonwer does not really work as a worksheet function it keeps popping up with a "Microsoft Office Excel is waiting for another appplication to complete an OLE action".

Any ideas on how to get around this issue?

Thanks again for your help.

[Kenneth Hobs]

My comments are always meant to help you. There is rarely a need to quote a post. Just put the post number in it or quote just snippets that need emphasized.

It all works fine on mine. How many cells are you testing at once? Try just one cell.

In the attachment, I also included Chip Pearson's dsoFile routine. If you don't have the dsofile.dll, you may need to get it if you want to try that code.

[xluser2007]

My comments are always meant to help you. There is rarely a need to quote a post. Just put the post number in it or quote just snippets that need emphasized.


HI Kenneth, duly noted. Please note that I I only try to be as clear as possible to people kind enough to help me (such as yourself), and try not to be vague in my posts. As a a result I sometimes get carried away and quote more than I need to, I'll try to keep it more relevant going forward :).




It all works fine on mine. How many cells are you testing at once? Try just one cell.



I was testing once cell, but I tried it again this morning and it works just great!

Many thanks.




It all works fine on mine. How many cells are you testing at once? Try just one cell.


I had to download it and it works well indeed, great code to have.

Thanks you very much for your help onthis thread, I'm sure it is useful to many. Thank you Zack for your efforts and interest also :thumb.

Thread Solved :friends:.

[Dr.K]

This may be quite expensive, and should not be used on a worksheet function, only from VBA (way too expensive for that)...

Wow... You and I have very different definitions of expensive. I have a bunch of Worksheet Functions that open an ADO Connection to my Datamart and pull in data. I wouldn't fill up a Worksheet with em, but they are a lifesaver if you need to look something up real quick.



The reason why I requested FSO was because I remembered seeing someone at work use it a while back and thought it was optimal

"optimal" is a dangerous word. I greatly prefer FSO for handling text files, but plenty of people prefer to use READ and WRITE.

For file handling, some of the FSO functions are faster then the built in VBA functions, but not by enough to bother. Some of the Properties are handy, though.