Get Network Login Name

[Michael]

Is there a code to get the Network Login Name and append that to a cell on a
worksheet?

 

[Barb Reinhardt]

Have you tried Environ("USERNAME") in VBA?

 

[EricG]

Methods for getting the full name and username (login ID) of the user:

http://www.mvps.org/access/api/api0066.htm

http://www.mvps.org/access/api/api0008.htm

You can get the login ID by calling the "fOSUserName()" function:

dim userName as String

userName = fOSUserName
activesheet.cells(1,1) = userName

HTH,

Eric

 

[Jacob Skaria]

Try this UDF (User Defined function). From workbook launch VBE using Alt+F11.
From menu Insert a Module and paste the below function.Close and get back to
workbook and try the below formula.

=GetUser()

Function GetUser()
Dim objNet As Object
Set objNet = CreateObject("WScript.NetWork")
GetUser = Trim(objNet.UserName)
End Function

If this post helps click Yes

 

[Gord Dibben]

Range("A1") = Environ("Username")

See reply at your other posting.

You may want to re-think this due to the weak security measures in Excel

If you don't want them to see confidential info.........don't include it in
the workbook.


Gord Dibben MS Excel MVP

 

[Michael]

Almost there!

Now how do I get the code to execute when the user opens the workbook?

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

Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If ( lngX > 0 ) Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = vbNullString
End If
End Function
'******************** Code End **************************

 

[JP Ronse]

Hi Michael,

This is some sample code I used to set-up something similar. In my project,
each user is able to open the workbook but can only access his worksheet
(absence card). The manager is able to view all cards and is the only one
who can approve absences or undo once approved.

If you are interested in this workbook, I'm willing to mail you the
unprocted file.

Wkr,

JP

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


Private Sub Workbook_Open()
''' get the login name and display the page for this person
Dim strLoginName As String
Dim wks As Worksheet
Dim intCount As Integer
Dim intManagerCount As Integer
Dim astrManagers()
Dim cllManager As Range
Dim intListIndex As Integer

'''''''Enter = "OpenStop"
On Error Resume Next
With Application
.ScreenUpdating = False
.CellDragAndDrop = False
.EnableAutoComplete = False
Worksheets("Absence Cards").Unprotect Password:=PROTECT_PW
strLoginName = LoginToCard
Logging strLoginName

''' if strLoginName refers to manager, set it to "JP"
''' managers are like WS(JP)
'''If InStr(1, strLoginName, "JP") > 0 Then strLoginName = "JP"

''' make the appropriate sheet visible
With Sheets(strLoginName)
.Visible = True
.chkAssistant.Value = False
.chkAssistant.Visible = False
End With

intManagerCount = Application.CountIf(Sheets("Absence
Cards").Range("E:E"), "*Manager*")
ReDim Preserve astrManagers(0 To intManagerCount - 1, 2)
With Sheets("Absence Cards").Range("E:E")
''' first manager
Set cllManager = .Find("*Manager*", LookIn:=xlValues)
If cllManager Like "Resource*" Then intListIndex = 0

astrManagers(0, 2) = cllManager.Offset(0, -4)
astrManagers(0, 1) = cllManager.Offset(0, -2) & " " &
cllManager.Offset(0, -1)
''' other managers
intCount = 1
If intManagerCount > 1 Then
Do While intCount < intManagerCount
Set cllManager = .FindNext(cllManager)
If cllManager Like "Resource*" Then intListIndex =
intCount
astrManagers(intCount, 2) = cllManager.Offset(0, -4)
astrManagers(intCount, 1) = cllManager.Offset(0, -2) & "
" & cllManager.Offset(0, -1)
intCount = intCount + 1
Loop
End If
End With
''' make all other sheets invisible
For Each wks In ThisWorkbook.Worksheets
If wks.Name <> strLoginName Then
wks.Visible = xlSheetVeryHidden
End If
If (wks.Name <> "ELSE" And wks.Name <> "Absence Cards") Or
wks.Name = "JP" Then Sheets(wks.Name).cmdApprove.Enabled = False
''' fill cmbManager
Select Case wks.Name
Case "ELSE", "Absence Cards", "Absence Codes"
Case Else
'''If wks.Name = "Model" Then Stop
''' add the managers to the cmbManager
With Sheets(wks.Name).cmbManager
.ListFillRange = ""
.ColumnCount = 2 'UBound(astrManagers, 1)
.ColumnWidths = "5cm,0cm"
.BoundColumn = 1
For intCount = .ListCount To 1 Step -1
.RemoveItem (intCount - 1)
Next intCount
For intCount = 0 To UBound(astrManagers, 1)
.AddItem
.List(intCount, 0) = astrManagers(intCount, 1)
.List(intCount, 1) = astrManagers(intCount, 2)
Next intCount
.ListIndex = intListIndex
End With
End Select
Next wks
.TransitionMenuKey = ""
.ScreenUpdating = True
End With

Select Case strLoginName
Case "JP"
''' add item in cells commandbar
With Application.CommandBars("Cell")
.Reset
.Controls.Add Type:=msoControlButton, Before:=1,
Temporary:=True
With .Controls(1)
.Caption = "Absence OK"
.OnAction = "AbsenceOK"
End With
.Controls.Add Type:=msoControlButton, Before:=2,
Temporary:=True
With .Controls(2)
.Caption = "Absence NOK"
.OnAction = "AbsenceNOK"
End With
End With
End Select
With ActiveWindow
.ScrollColumn = 1
.ScrollRow = 1
End With
On Error GoTo 0
End Sub


Function LoginToCard() As String
Dim lpBuffer As String
Dim nSize As Long
Dim lngRet As Long
Dim cllPlanningManager As Range

''' init strBuffer & lnglenbuf
nSize = 255
lpBuffer = String$(nSize, vbNullChar)
lngRet = GetUserName(lpBuffer, nSize)

''' strip tailing nullchars
lpBuffer = Left(lpBuffer, InStr(1, lpBuffer, vbNullChar,
vbTextCompare) - 1)
'''lpBuffer = "PETVERR"
'''lpBuffer = "WISU"

'''Stop
'''gvarAbsenceCards = Sheets("Absence Cards").Cells(1, 1).CurrentRegion

If IsError(Application.VLookup(lpBuffer, Sheets("Absence
Cards").Cells(1, 1).CurrentRegion, 2, False)) Then
LoginToCard = "ELSE"
Else

''' check if the caller is known as manager
If Application.VLookup(lpBuffer, Sheets("Absence Cards").Cells(1,
1).CurrentRegion, 5, False) Like "*Manager*" Then
gstrRealLogin = Application.VLookup(lpBuffer, Sheets("Absence
Cards").Cells(1, 1).CurrentRegion, 2, False)
''' find the planning manager
Set cllPlanningManager = Sheets("Absence
Cards").Range("E:E").Find("*Resource*", LookIn:=xlValues)
If cllPlanningManager Is Nothing Then
LoginToCard = "ELSE"
Else
LoginToCard = cllPlanningManager.Offset(0, -3)
'''Stop
End If
Else
LoginToCard = Application.VLookup(lpBuffer, Sheets("Absence
Cards").Cells(1, 1).CurrentRegion, 2, False)
End If
End If
End Sub