Problems callilng MAPI from Excel

Posted on 2014-11-13
Medium Priority
Last Modified: 2014-12-29
I have simple code in an Excel 2010 macro to call MAPI from within Excel to retrieve currentuser. The Outlook 14 Library is enabled and it works fine.

Dim userName As String
Dim objNS As Outlook.Namespace
Set objNS = Outlook.GetNamespace("MAPI")
userName = objNS.Session.CurrentUser.Name

However, our IT group has set up a test network that is a clone of our live network. I need do a remote connection to the test network and test the excel Macro there on remote workstations (some are windows server 2003, some Win7). When I run the macro it throws an error at setting the username to the objNs.session.currentUser.name. I have tried on multiple test network workstations with similar results.

If I step through debug with a watch, sometimes it errors out and I get an invalid object, sometimes if I step very slowly  it doesn't. It appeared that there seemed to potentially be a timing error where the MAPI object is not loading fast enough, so retrieving the attribute failed. I tried putting in application.wait statements, but that doesn't seem to work.

I've tried several different forms of MAPI object instantiation with no luck.

Thx for any help
Question by:fredjonzeTwo
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 5
  • 2
  • +1
LVL 12

Expert Comment

ID: 40441806

Set objNS = Application.GetNamespace("MAPI")
userName = objNS.CurrentUser

Open in new window


Author Comment

ID: 40441858
Same behavior, assignment works if I do a debug/step and fails if I run without debugging.

Thanks for the idea....any others?

LVL 12

Expert Comment

ID: 40441919
Would you mind posting the Excel file that contains the macro/code so I can test at my end?

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.


Author Comment

ID: 40449920
Sorry for the delay, other work priorities. Over the weekend I did more research and found someone who had the same problem. Instead of just doing a single wait, as I initially did, they implemented a looping wait. this apparently allows the system to refresh and load. I've found that it can take over 8 seconds to load the MAPI assembly. Here's the new code that seems to work. I have to use late binding because users are on various versions of office.

Dim olApp As Object
Dim userName As String

On Error Resume Next
Set olApp = GetObject("Outlook.Application")
Do Until Not (olApp Is Nothing)
    Set olApp = CreateObject("Outlook.Application")
    Application.Wait (Now + #12:00:01 AM#)
Set objNS = olApp.GetNamespace("MAPI")
userName = objNS.CurrentUser
LVL 49

Expert Comment

by:Martin Liss
ID: 40494382
I've requested that this question be closed as follows:

Accepted answer: 0 points for fredjonzeTwo's comment #a40449920

for the following reason:

This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
LVL 26

Accepted Solution

Nick67 earned 1500 total points
ID: 40494336
Try this!
Put it all in a code module
Option Compare Database
Option Explicit

Private Type USER_INFO_2
    usri2_name As Long
    usri2_password  As Long  ' Null, only settable
    usri2_password_age  As Long
    usri2_priv  As Long
    usri2_home_dir  As Long
    usri2_comment  As Long
    usri2_flags  As Long
    usri2_script_path  As Long
    usri2_auth_flags  As Long
    usri2_full_name As Long
    usri2_usr_comment  As Long
    usri2_parms  As Long
    usri2_workstations  As Long
    usri2_last_logon  As Long
    usri2_last_logoff  As Long
    usri2_acct_expires  As Long
    usri2_max_storage  As Long
    usri2_units_per_week  As Long
    usri2_logon_hours  As Long
    usri2_bad_pw_count  As Long
    usri2_num_logons  As Long
    usri2_logon_server  As Long
    usri2_country_code  As Long
    usri2_code_page  As Long
End Type

Public Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private Declare Function GetComputerName Lib "kernel32" _
Alias "GetComputerNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long

Private Declare Function apiNetGetDCName _
    Lib "netapi32.dll" Alias "NetGetDCName" _
    (ByVal servername As Long, _
    ByVal DomainName As Long, _
    bufptr As Long) As Long
' function frees the memory that the NetApiBufferAllocate
' function allocates.
Private Declare Function apiNetAPIBufferFree _
    Lib "netapi32.dll" Alias "NetApiBufferFree" _
    (ByVal buffer As Long) _
    As Long
' Retrieves the length of the specified wide string.
Private Declare Function apilstrlenW _
    Lib "kernel32" Alias "lstrlenW" _
    (ByVal lpString As Long) _
    As Long
Private Declare Function apiNetUserGetInfo _
    Lib "netapi32.dll" Alias "NetUserGetInfo" _
    (servername As Any, _
    username As Any, _
    ByVal Level As Long, _
    bufptr As Long) As Long
' moves memory either forward or backward, aligned or unaligned,
' in 4-byte blocks, followed by any remaining bytes
Private Declare Sub sapiCopyMem _
    Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As Any, _
    Source As Any, _
    ByVal Length As Long)
Private Declare Function apiGetUserName Lib _
    "advapi32.dll" Alias "GetUserNameA" _
    (ByVal lpBuffer As String, _
    nSize As Long) _
    As Long
Private Const MAXCOMMENTSZ = 256
Private Const NERR_SUCCESS = 0
Private Const ERROR_MORE_DATA = 234&
Private Const MAX_CHUNK = 25
Private Const ERROR_SUCCESS = 0&

'******** Code Start ********
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'Code Courtesy of
'Dev Ashish
Function fGetFullNameOfLoggedUser(Optional strUserName As String) As String
' Returns the full name for a given UserID
'   NT/2000 only
' Omitting the strUserName argument will try and
' retrieve the full name for the currently logged on user
On Error GoTo ErrHandler
Dim pBuf As Long
Dim dwRec As Long
Dim pTmp As USER_INFO_2
Dim abytPDCName() As Byte
Dim abytUserName() As Byte
Dim lngRet As Long
Dim i As Long
    ' Unicode
    abytPDCName = fGetDCName() & vbNullChar
    If (Len(strUserName) = 0) Then strUserName = fGetUserName()
    abytUserName = strUserName & vbNullChar
    ' Level 2
    lngRet = apiNetUserGetInfo( _
                            abytPDCName(0), _
                            abytUserName(0), _
                            2, _
    If (lngRet = ERROR_SUCCESS) Then
        Call sapiCopyMem(pTmp, ByVal pBuf, Len(pTmp))
        fGetFullNameOfLoggedUser = fStrFromPtrW(pTmp.usri2_full_name)
    End If
    Call apiNetAPIBufferFree(pBuf)
    Exit Function
    fGetFullNameOfLoggedUser = vbNullString
    Resume ExitHere
End Function
Private Function fGetUserName() As String
' Returns the network login name
Dim lngLen As Long, lngRet As Long
Dim strUserName As String
    strUserName = String$(254, 0)
    lngLen = 255
    lngRet = apiGetUserName(strUserName, lngLen)
    If lngRet Then
        fGetUserName = Left$(strUserName, lngLen - 1)
    End If
End Function
Function fGetDCName() As String
Dim pTmp As Long
Dim lngRet As Long
Dim abytBuf() As Byte
    lngRet = apiNetGetDCName(0, 0, pTmp)
    If lngRet = NERR_SUCCESS Then
        fGetDCName = fStrFromPtrW(pTmp)
    End If
    Call apiNetAPIBufferFree(pTmp)
End Function
Private Function fStrFromPtrW(pBuf As Long) As String
Dim lngLen As Long
Dim abytBuf() As Byte
    ' Get the length of the string at the memory location
    lngLen = apilstrlenW(pBuf) * 2
    ' if it's not a ZLS
    If lngLen Then
        ReDim abytBuf(lngLen)
        ' then copy the memory contents
        ' into a temp buffer
        Call sapiCopyMem( _
                abytBuf(0), _
                ByVal pBuf, _
        ' return the buffer
        fStrFromPtrW = abytBuf
    End If
End Function

Function ReturnUserName() As String
' returns the NT Domain User Name
Dim rString As String * 255, sLen As Long, tString As String
    tString = ""
    On Error Resume Next
    sLen = GetUserName(rString, 255)
    sLen = InStr(1, rString, Chr(0))
    If sLen > 0 Then
        tString = Left(rString, sLen - 1)
        tString = rString
    End If
    On Error GoTo 0
    ReturnUserName = UCase(Trim(tString))
End Function

Function ReturnComputerName() As String
    Dim rString As String * 255, sLen As Long, tString As String
    tString = ""
    On Error Resume Next
    sLen = GetComputerName(rString, 255)
    sLen = InStr(1, rString, Chr(0))
    If sLen > 0 Then
        tString = Left(rString, sLen - 1)
        tString = rString
    End If
    On Error GoTo 0
    ReturnComputerName = UCase(Trim(tString))
End Function

Open in new window

Then call fGetFullNameOfLoggedUser() and see if it returns what you need

Author Comment

ID: 40494360
Thanks for an alternate solution. It will take me a little time to test as I'm working on other priorities. I'll test and respond.

Does this solution have any issues if there are mixed 32/64bit OS workstations?
LVL 26

Expert Comment

ID: 40494379
Shouldn't have Windows OS issues.
I run mixed 32/64 Windows 7 environments.

If you are running VBA 7 in 64-bit Office (not likely) then the API calls need to be altered.
Since you've replied, I hit 'Object' to keep this Q from being deleted.
LVL 26

Expert Comment

ID: 40494383
Things are moving again!

Author Comment

ID: 40518517

Finally got time to test the code. Had to comment out 'option compare database' as I'm using Excel. I tested the call and it is returning the OS username which, for our network, can be a little confusing to understand compared to the MAPI name (actual name).

The reason I'm using MAPI is that the workbook has a number of processes to email an extract of the workbook to the user and others for approvals, so I have to use MAPI anyway.

I'm going to accept your solution because it provides an alternate method and does seem to function...but I will need to stick with the MAPI for now to use the email functionality.

Thanks for taking the time to respond and  follow up!

LVL 26

Expert Comment

ID: 40522019
When I run the macro it throws an error at setting the username to the objNs.session.currentUser.name. I have tried on multiple test network workstations with similar results.

I wonder...
If you haven't set up Outlook as the logged-on user you are likely to throw an error.
On the workstations involved in the test network, Outlook may be installed -- but has an Outlook profile been created for the user?

If Outlook is not running on the local computer, GetApplicationObject creates a new instance of Outlook, uses the Logon method of the NameSpace object to log on to the default profile, and returns that new instance of Outlook.

If there's no default profile, there's likely to be grief!

Author Comment

ID: 40522258
It may be so. I have no control over the test network or processes, and IT periodically wipes the workstations and resets to defaults. I'll make sure to add a note to the workbook to explain the email based processes won't work unless the user first log in to Outlook and set up a profile.

Thanks for the feedback!

LVL 26

Expert Comment

ID: 40522263
No problem.
Hopefully, this provides a working Answer to your question.


Featured Post

Free Backup Tool for VMware and Hyper-V

Restore full virtual machine or individual guest files from 19 common file systems directly from the backup file. Schedule VM backups with PowerShell scripts. Set desired time, lean back and let the script to notify you via email upon completion.  

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
This article describes how to import Lotus Notes Contacts into Outlook 2016, 2013, 2010 and 2007 etc. with a few manual steps. You can easily export and migrate Lotus Notes contacts into Microsoft Outlook without having to use any third party tools.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
Suggested Courses

770 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question