capturing the currentuser...

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Is there any way to return the current user's name or email address
programmatically? I know there are problems with identifying names from the
current profile in Outlook but is there a registry setting or similar (I'm
using version 2003)?
 
Try this:

Dim objNS As Outlook.NameSpace
Dim objRecip As Recipient

Set objNS = Application.GetNamespace("MAPI")
Set objRecip = objNS.CurrentUser
Debug.Print objRecip.Name & ": " & objRecip.Address

Set objNS = Nothing
Set objRecip = Nothing
 
Thanks Eric. That's great; the only problem is that it generates a
recurrence of the old problem with the anti-virus message ("A program is
trying to access email addresses..."). Have you a solution to this (other
than changing the registry) or perhaps another way of accessing the user's
name?
 
Depending on what you're trying to achieve...

You can use Environ("username") to get the *machine's* current
user/logon name - obviously it's not necessarily the same as the Outlook
namespace but if you just need a unique name for logging purposes or
something then it should do.
 
Yes it does seem strange but I'm using your code verbatim. It's when it hits
the objRecip.Name line that the security message pops up. I tried using the
old ActiveInspector.Session instead of GetNameSpace but it still generates
the security message.
 
I have encapsulated your code in the ThisOutlookSession, in the NewInspector
event. Why would this be the problem?
 
Thanks for taking the time Eric. I'll include the relevant procedures below.
Just to explain, in our organisation users use two mailboxes within Exchange
for work they do for two different parts of the company - this involves two
separate email addresses and matching user names (as they appear on the GAL)
with or without "(Ltd)" at the end. Everyone's prompted for one of two
profiles when they enter Outlook but, because of potential errors, we still
want to be sure everyone is prompted again for the From address when they
create a new message (or reply or forward). Sadly the Accounts button that
works so well with separate SMTP accounts doesn't seem to be available for
mailboxes within the same server (if I'm missing something, please let me
know!).

Two other things (if you have the time!):
There's a matching signature for each mailbox and I'm currently including
that at the end of the process using the CurrentItem_Send event. I would
prefer to do this at the start of a new message but can't see an easy way to
swap to the other signature if the user then changes their mind as to whom
the message is from. Also, I can't say I'm proud of the series of SendKeys
statements at the end but, in the absence of the Dialogs collection, I'm at a
loss to finding a neater way to get into the From list!

Option Explicit
Public WithEvents myInspectors As Outlook.Inspectors
Public WithEvents CurrentInspector As Outlook.Inspector
Public WithEvents CurrentItem As Outlook.MailItem
Dim profUserName As String
Dim aUserName As String
Dim bUserName As String

Private Sub Application_Startup()
Set myInspectors = Application.Inspectors
End Sub

Private Sub myInspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
On Error GoTo handler
Dim myMail As Outlook.MailItem
Dim objNS As Outlook.NameSpace
Dim objRecip As Recipient

'checks this is a new mail message
If Not TypeOf Inspector.CurrentItem Is Outlook.MailItem Then Exit Sub
Set CurrentInspector = Inspector
Set myMail = CurrentInspector.CurrentItem
Set CurrentItem = myMail
If myMail.Sent Or myMail.Parent = "Drafts" Then Exit Sub

'obtains default user name and creates A and B versions
Set objNS = Application.GetNamespace("MAPI")
Set objRecip = objNS.CurrentUser
profUserName = objRecip.Name

If InStr(1, profUserName, " (Ltd)") = 0 Then
aUserName = profUserName
Else
aUserName = Left(profUserName, InStr(1, profUserName, " (Ltd)") - 1)
End If
bUserName = aUserName & " (Ltd)"

'activates "From" button and narrows address list down to names that match
user
SendKeys "%r"
SendKeys "%v"
SendKeys "{down 3}"
SendKeys "{enter}"
SendKeys aUserName
SendKeys "{enter}"

Set myMail = Nothing
Set objNS = Nothing
Set objRecip = Nothing

Exit Sub

handler:
If Err.Number = 287 Then 'if user clicks "No" to Outlook security
message
MsgBox "Tick 'Allow access for 1 minute' and then click on 'Yes' so
that Outlook can look up your name", vbCritical
Resume
Else
MsgBox Err.Number & " " & Err.Description
End If

End Sub
 
Back
Top