Problems callilng MAPI from Excel

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
fredjonzeTwoAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

jkaiosIT DirectorCommented:
Try:

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

Open in new window

0
fredjonzeTwoAuthor Commented:
Same behavior, assignment works if I do a debug/step and fails if I run without debugging.

Thanks for the idea....any others?

Thx,
0
jkaiosIT DirectorCommented:
Would you mind posting the Excel file that contains the macro/code so I can test at my end?
0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

fredjonzeTwoAuthor Commented:
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#)
Loop
Set objNS = olApp.GetNamespace("MAPI")
userName = objNS.CurrentUser
0
Martin LissOlder than dirtCommented:
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.
0
Nick67Commented:
Why MAPI?
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, _
                            pBuf)
    If (lngRet = ERROR_SUCCESS) Then
        Call sapiCopyMem(pTmp, ByVal pBuf, Len(pTmp))
        fGetFullNameOfLoggedUser = fStrFromPtrW(pTmp.usri2_full_name)
    End If
 
    Call apiNetAPIBufferFree(pBuf)
ExitHere:
    Exit Function
ErrHandler:
    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, _
                lngLen)
        ' 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)
    Else
        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)
    Else
        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
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
fredjonzeTwoAuthor Commented:
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?
0
Nick67Commented:
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.
0
Nick67Commented:
Things are moving again!
0
fredjonzeTwoAuthor Commented:
Nick,

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!

Jim
0
Nick67Commented:
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.
http://msdn.microsoft.com/en-us/library/office/ff869819(v=office.15).aspx

If there's no default profile, there's likely to be grief!
0
fredjonzeTwoAuthor Commented:
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!

Jim
0
Nick67Commented:
No problem.
Hopefully, this provides a working Answer to your question.

Nick67
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.