Below is an example that reads the Office username and initials from the
registry. Depending on the Office version the information is stored with a
different key and data type. In this example I used the Office 2007 (12.0)
version which stores the values as strings. Change the value of
'MyOfficeVersion' to 11.0 for Office 2003. Office 2003 stores the values in
a binary format.
Private Function RegBinaryToString(BinReg As Variant) As String
Dim i As Integer, Wd As Long, Result As String
For i = LBound(BinReg) To UBound(BinReg) Step 2
Wd = BinReg(i)
Wd = Wd + BinReg(i + 1) * 256
If Wd > 0 Then Result = Result & ChrW(Wd)
Next
RegBinaryToString = Result
End Function
Public Function ReadRegisteryKey(RKey As String) As String
' Windows Script Host Object Model reference
Dim oKey As New IWshShell_Class
Dim RKeyValue As String
Dim RegVal As Variant, Entry As Variant
On Error Resume Next
'Set oKey = CreateObject("Wscript.Shell")
' When using late binding
RegVal = oKey.RegRead(RKey)
If Err.Number = 0 Then
If TypeName(RegVal) = "String" Then
RKeyValue = RegVal
ElseIf TypeName(RegVal) = "Variant()" Then
RKeyValue = RegBinaryToString(RegVal)
Else
RKeyValue = CStr(RegVal)
End If
ReadRegisteryKey = RKeyValue
Else
'Debug.Print Err.Number & ": " & Err.Description
ReadRegisteryKey = vbNullString
Err.Clear
End If
Set oKey = Nothing
End Function
Public Function OfficeUserInfo(Optional Initials As Boolean = False) As
String
' Get full user name or initials from Microsoft Office
Const MyOfficeVersion = "12.0"
Const MsOfficeKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\"
Dim UsrInfoKey As String, OffVersn As String
OffVersn = MyOfficeVersion
If Initials Then UsrInfoKey = "UserInitials" Else UsrInfoKey = "UserName"
If OffVersn = "12.0" Then
OfficeUserInfo = ReadRegisteryKey(MsOfficeKey & _
"\Common\UserInfo\" & UsrInfoKey)
Else
OfficeUserInfo = ReadRegisteryKey(MsOfficeKey & _
OffVersn & "\Common\UserInfo\" & UsrInfoKey)
End If
End Function
Sub Demo()
MsgBox OfficeUserInfo() & String(20, " ") & vbCr & OfficeUserInfo(True) &
vbCr
End Sub
Vincent Verheul said:
Hi JP,
CurrentUser yields the Acces user. When you have not set up security, this
will always be "Admin". What I'm looking for is the full user name "John
Doe Junior" and his initials JDJ as specified when you use an Office
application for the first time after installation on a computer. This is a
typical Office property.
These are stored in the registry under
\HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\UserInfo\UserName
and \UserInitials (or office 12.0 when using Office 2007). The data is in
binary format. So I'll have to convert it to text. A quick property in VBA
would have been easier.
Vincent
In Access, check out the CurrentUser property.
Application.CurrentUser
--JP
Hi,
I would like to get the [full user name] and [initials] as defined in
Microsoft Office. In Access 2007 you will find this under Access
Options -
Popular - Personalize your copy of Microsoft Office.
I'm working with VBA in MsAccess 2003 and 2007. I would have expected a
method from MsAccess itself or in the Microsoft Office Object Library,
but I
have not been able to find it there. In MsWord it's easy:
Application.UserName and Application.UserInitials give the results. But
in
Access that seems not to be so straightforward. I can launch an instance
of
Word to get it, but that's quite a bit of overhead...
Suggestions?
Thanks,
Vincent
