Every now and again, I have the job of archiving vast numbers of workbooks: a penance for failing to move the users on from using Excel for primary data storage and saving down each day's valuations in a separate sheet.
As you can imagine, this gets tedious, and it needs automating... Any fool can write a script to delete, zip or move files around, and many fools have done so: few were so damned by their actions in a past life as to be doomed to notify the file owners by email.
But who owns the file?
Every now and again, Windows shows that a simple question can be made to have an absurdly difficult answer, and finding the owner of a named file is one of the worst I've come across. The API calls have been analysed and explained by Emmet Gray:
http://www.emmet-gray.com/Articles/GetOwner.htm
You are welcome to read it and try out the code: it is a remarkable feat of analysis and simplification in the face of the wilfully illogical and obscure and, despite being pared down and superbly documented, it is a truly intimidating piece of API coding. You cannot extract the Security Descriptor of a file in less than a hundred lines of code and, when you've got it, you will rapidly realise that opening up and interrogating a file's Security Descriptor for the SID of the user only leads to an even deeper travail in extracting a human-readable user name. I do not believe that it can be done in less than a thousand lines of code and I would question whether it can be done reproducibly and reliably - let lone clearly - which is to say that it probably shouldn't be done in VBA.
But I've still got the job of digging out the user names for all the files I'm archiving. The code snippet below uses WMI - Windows Management Information - a truly horrible API released (but not documented) by Microsoft for systems administrators. If WMI is an improvement, I shudder to think what they had to do before it existed, and I am astonished that the haven't all turned into the BOFH (Look it up. But not at work). But it is at least short. All it is, is a 'Get Owner' function and a small Scripting wrapper that searches a folder and lists the files...
Private Function GetFileOwner(strFile As String, Optional WithDomainName As Boolean = False) As String
' Returns the owner of a file or folder, or a comma-delimited list if there are multiple owners.
' Usage:
' Debug.Print GetFileOwner("H:\Personal\MyFile.txt")
' heffernann
'
' Debug.Print GetFileOwner("H:\Personal\MyFile.txt", TRUE)
' OLYMPUS\heffernann
'
' Debug.Print GetFileOwner("\\OLYMPUS\Users\heffernann\Personal\MyFile.txt", TRUE)
' [returns nothing, see below]
' This works with local drives and mapped drives, but fully-qualified network paths do not work.
' According to the documentation, WMI will return an error when the file owner is a user who has
' been purged from the system. However, all that happens here is that we get an empty collection
' Author: Nigel Heffernan
' The underlying technology is WMI (Windows Management Information).
' The WMI documentation is very poor, even by the standards of MSDN.
' However, Microsoft's 'Hey! Scripting Guy!' site has usable information:
' http://www.microsoft.com/technet/scriptcenter/resources/qanda/oct04/hey1007.mspx
Static objWMIService As Object ' Persistent object: this is called repeatedly,
' so you may prefer to declare it at module level
' and instantiate/dismiss it explicitly
Dim colItems As Object
Dim objItem As Object
Dim strComputer As String
Dim strWMI_Query As String
Dim strOwner As String
Dim strOutput As String
Dim iCount As Integer
Const wbemFlagReturnImmediately As Long = 16
Const wbemFlagForwardOnly As Long = 32
Dim IFlags As Long
IFlags = wbemFlagReturnImmediately + wbemFlagForwardOnly
strComputer = "." ' WMI notation for 'This machine'
' WMI script sometimes works if remote machine names are specified
' but you'll need to specify the local path when looking up files
strWMI_Query = ""
strWMI_Query = strWMI_Query & "ASSOCIATORS OF "
strWMI_Query = strWMI_Query & "{Win32_LogicalFileSecuritySetting='" & strFile & "'}"
strWMI_Query = strWMI_Query & " WHERE AssocClass=Win32_LogicalFileOwner ResultRole=Owner"
' WMI Association classes can be instantiated directly, but the syntax is arcane.
' Querying the WMI data service is simpler, if you can find a pre-existing query template
If objWMIService Is Nothing Then
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
End If
' ExecQuery is relatively easy to do, but rather slow
Set colItems = objWMIService.ExecQuery(strWMI_Query, , IFlags)
' AssociatorsOf is faster, and is documented here: http://msdn.microsoft.com/en-us/library/aa393858(VS.85).aspx
'Set colItems = objWMIService.AssociatorsOf("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2", "Win32_LogicalFileOwner", "SWbemObjectEx", "Owner", , , , , , IFlags)
strOutput = ""
iCount = 0
On Error Resume Next
For Each objItem In colItems
strOwner = ""
If WithDomainName Then
strOwner = objItem.ReferencedDomainName & "\" & objItem.AccountName
Else
strOwner = objItem.AccountName & ","
End If
strOutput = strOutput & strOwner
Next objItem
'Trim trailing comma:
strOutput = Trim(strOutput)
If Len(strOutput) > 0 Then
strOutput = Left(strOutput, Len(strOutput) - 1)
End If
GetFileOwner = strOutput
End Function
Public Sub RecurseFolder(strFolder As String, Optional RecursionLevel As Integer = 0, Optional minDateLastModified As Date = 0, Optional minSize As Double = 0)
' Recursive Subroutine to enumerate the contents of an NT folder.
' Writes the results to a log file
' Subfolders are enumerated by a recursive call
' For use in Excel VBA: can be converted to VBScript
' REQUIRES module-level declarations:
' objLogStream (Scripting.TextStream)
' objFSO (Scripting.FileSystemObject)
' LogfileName (string)
' REQUIRES Subroutines and Functions:
' GetFileOwner
' Logfile
' CloseLogFile
' VBA Declarations:
Dim objFolder As Folder
Dim objSubFolder As Folder
Dim objFile As File
Dim strFile As String
Dim strMessage As String
Dim strOwner As String
Dim strSize As String
Dim lngCountLog As Long
If objFSO Is Nothing Then
Set objFSO = New FileSystemObject
End If
Set objFolder = objFSO.GetFolder(strFolder)
Application.StatusBar = "Searching folders: " & RecursionLevel & " layers: " & strFolder
' Use this if you're reporting progress on a worksheet (requires named range as shown):
ThisWorkbook.Names("CurrentFolder").RefersToRange.Value = strFolder
strOwner = GetFileOwner(objFolder.Path)
On Error Resume Next
strMessage = ""
strMessage = strMessage & "FOLDER" & vbTab & objFolder.name & vbTab & 0 & vbTab & objFolder.DateLastModified & vbTab & objFolder.DateLastAccessed & vbTab & strOwner & vbTab & objFolder.Path & vbTab & RecursionLevel
Logfile strMessage
lngCountLog = 0
For Each objFile In objFolder.Files
strFile = objFile.Path
If objFile.DateLastModified >= minDateLastModified Then
If objFile.Size >= minSize Then
strOwner = ""
strOwner = GetFileOwner(objFile.Path)
strMessage = ""
strMessage = strMessage & "FILE" & vbTab & objFile.name & vbTab & objFile.Size & vbTab & objFile.DateLastModified & vbTab & objFile.DateLastAccessed & vbTab & strOwner & vbTab & objFolder.Path & vbTab & RecursionLevel
Logfile strMessage
lngCountLog = lngCountLog + 1
End If 'objFile.Size > minSize Then
End If ' objFile.DateLastModified > minDateLastModified
Next objFile
' Use these f you're reporting progress on a worksheet (requires named ranges as shown):
ThisWorkbook.Names("CurrentCount").RefersToRange.Value = ThisWorkbook.Names("CurrentCount").RefersToRange.Value + objFolder.Files.Count
ThisWorkbook.Names("CurrentCountLogged").RefersToRange.Value = ThisWorkbook.Names("CurrentCountLogged").RefersToRange.Value + lngCountLog
For Each objSubFolder In objFolder.SubFolders
RecursionLevel = RecursionLevel + 1
RecurseFolder objSubFolder.Path, RecursionLevel, minDateLastModified, minSize
RecursionLevel = RecursionLevel - 1
Next objSubFolder
End Sub
Public Sub Logfile(strMessage)
' Stream a message to a log file
' Opens the file if required.
' You are advised to close the file explicitly when your process has completed: use CloseLogFile for this
' REQUIRES module-level declarations:
' objLogStream (Scripting.TextStream)
' objFSO (Scripting.FileSystemObject)
' LogfileName (string)
Dim strHeader As String
If objLogStream Is Nothing Then
Set objLogStream = objFSO.OpenTextFile(LogfileName, ForWriting, True)
strHeader = "Type" & vbTab & "Filename" & vbTab & "Size" & vbTab & "DateLastModified" & vbTab & "DateLastAccessed" & vbTab & "Owner" & vbTab & "ParentFolder" & vbTab & "PathDepth"
objLogStream.WriteLine strHeader
End If
objLogStream.WriteLine strMessage
End Sub
Public Sub CloseLogFile()
If objLogStream Is Nothing Then
Exit Sub
End If
objLogStream.Close
Set objLogStream = Nothing
End Sub
Feel free to try out the code - and do, please, feel free to tell me how you got on. Oh, and watch out for line breaks imposed by Blogger's atomatic formatting.
No comments:
Post a Comment