'=======================================================================================
'- ACCESS A .XLS FILE TO GET LAST USER NAME
'- CAN ALSO BE USED IF THE FILE IS IN USE
'- NB. This code works in XL97 and XL2000 - don't know about others
'=======================================================================================
'- NB.1.Cannot get this by *opening* the workbook because we then become the last user.
'- 2.Not the same as the "Last saved by" property which requires opening the workbook.
'- 3.No security. A user can change their name temporarily in Tools/Options.
'=======================================================================================
'- Last user name is preceded by characters [\][0][p][0][??][0][0]
'- [??] is a variable character - its code shows the number of characters in the name.
'- followed by any number of spaces (and can include spaces)
'- Method : Use a Regular Expression to find the precedes + 50 following characters
'- ..... then use the [??] character to extract the string
'- Brian Baulsom December 2007
'========================================================================================
Sub GetLastUser()
Dim MyFile As String ' File name
Dim MyRegExp As Object
Dim MyLastUser ' last user name
Dim LastUserLen As Integer ' character 5 name length
Dim FileString As String ' file converted to a string in memory
Dim MyMatches As Variant ' RegExp array of matches (should only be 1)
Dim MyLastSaved As String ' "Last saved by" from properties
'---------------------------------------------------------------------------------
ChDrive "F:\"
ChDir "F:\"
MyFile = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
If MyFile = "False" Then End
'----------------------------------------------------------------------------------
'- PUT THE FILE INTO MEMORY AND CLOSE IT
Open MyFile For Binary Access Read Shared As #1
FileString = Space(LOF(1))
Get 1, 1, FileString
Close #1
'----------------------------------------------------------------------------------
'- SET UP A REGULAR EXPRESSION
Set MyRegExp = CreateObject("VbScript.RegExp")
With MyRegExp
.Global = True
.Pattern = "\\\x00p\x00.\x00\x00.{50}" ' 57 characters should be enough
Set MyMatches = .Execute(FileString) ' zero based array
'------------------------------------------------------------------------------
'- DISPLAY RESULTS (should only be 1 match = Matches(0))
'------------------------------------------------------------------------------
'- check only 1
If MyMatches.Count <> 1 Then
MsgBox ("Found " & MyMatches.Count & " matches" & vbCr _
& "Only showing first one.")
End If
'------------------------------------------------------------------------------
'- exclude first 7 characters & trailing spaces
MyLastUser = MyMatches(0) ' 57 characters found
LastUserLen = Asc(Mid(MyLastUser, 5, 1)) ' length of name
MyLastUser = Mid(MyLastUser, 8, LastUserLen) ' extract name
'------------------------------------------------------------------------------
'- Message
rsp = MsgBox(MyFile & vbCr & "Last user : " & MyLastUser)
'--------------------------------------------------------------------------------
FileString = ""
End With
'------------------------------------------------------------------------------------
End Sub
'========================================================================================