Username Code help - Slow processing speed

Good Morining All,

I have managed to put together a Macro which finds out the Username if a user within Excel.
I did have this code without the Application.Volatile but it didn't work. The downside of this is that if I have this included it slows down the whole spreadsheet.

The Code was taken from various different sources so I do not claim to be the originator of the code. Nor am I precious about it. If you guys can think of a way to get the spreadsheet on open to tell me the username that would be brilliant.

The function I call to find out the name is fGetUsername

Thanks in advance.

James Burton.

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

Private Declare Function apiNetGetDCName Lib "Netapi32.dll" Alias "NetGetDCName" (ByVal servername As Long, ByVal DomainName As Long, bufptr As Long) As Long

Private Declare Function apiNetAPIBufferFree Lib "Netapi32.dll" Alias "NetApiBufferFree" (ByVal buffer As Long) As Long

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

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 Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

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

Private strUserID As String

Private strUserName As String

Private strComputerName As String

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&

Public Function fGetUserName() As String
Application.Volatile
' 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
Application.Calculate

End Function

Private Sub Class_Initialize()
On Error Resume Next
'Returns the network login name
Dim strTempUserID As String, strTempComputerName As String

'Create a buffer
strTempUserID = String(100, Chr$(0))
strTempComputerName = String(100, Chr$(0))

'Get user name
GetUserName strTempUserID, 100

'Get computer name
GetComputerName strTempComputerName, 100

'Strip the rest of the buffer
strTempUserID = Left$(strTempUserID, InStr(strTempUserID, Chr$(0)) - 1)
Let strUserID = LCase(strTempUserID)

strTempComputerName = Left$(strTempComputerName, InStr(strTempComputerName, Chr$(0)) - 1)
Let strComputerName = LCase(strTempComputerName)

Let strUserName = DragUserName(strUserID)

End Sub

Public Property Get UserID() As String
UserID = strUserID
End Property

Public Property Get UserName() As String
UserName = strUserName
End Property

Public Function DragUserName(Optional strUserName As String) As String
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 strUserName = "" Then strUserName = GetUserName()
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))
DragUserName = fStrFromPtrW(pTmp.usri2_full_name)
End If

Call apiNetAPIBufferFree(pBuf)
ExitHere:
Exit Function
ErrHandler:
DragUserName = vbNullString
Resume ExitHere
End Function

Public Property Get ComputerName() As String
ComputerName = strComputerName
End Property

Private Sub Class_Terminate()
strUserName = ""
strComputerName = ""
End Sub

Public 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

Public 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

Can you not use:

Please Login or Register  to view this content.

?

Originally Posted by Izandol

Please Login or Register  to view this content.

You must please learn code tags.

Thanks but that doesn't seem to update my field. I have the value stored on a sheet which is usually hidden. Although when I run the code in the immediate window it displays the username for that user it doesn't recalculate the field. Even when i request excel to select the field and recalc (all within code) it doesn't work. I have to manually f2 and enter the field before it shows correctly.

Any ideas? I want to move away from application.volatile but that is slowing the workbook down.

Cheers

You have to use application.volatile to get it to update I believe, it shouldn't slow the workbook down with just one line in the function.