如何从VBA获取当前登录的Active Directory用户名？

我是Active Directory新手

我有一个VBA Excel加载项，该加载项应在且仅当运行它的计算机当前登录到Active Directory（无论是本地还是通过VPN）时运行

知道域名后，如何检索当前登录用户的用户名

谢谢

试试这个

MsgBox Environ("USERNAME")

---

编辑：如果我正确理解您的情况，那么您可能会走错方向

当你的应用程序启动时，你可以对一台机器进行简单的ping操作，用户只能查看他们是否连接到你的网络，是否登录到本地网络或是否通过VPN连接

如果他们已经可以访问您的本地网络，这意味着他们已经针对任何机制进行了身份验证，无论是Active Directory还是其他机制，这意味着他们“当前已登录”

另一方面，Active Directory本身不知道是否有人登录。你不可能做这样的事情：

ActiveDirectory.getIsThisUserLoggedIn("username");

---

Active Directory只充当用户元数据、安全性和身份验证的机制。

我知道现在有点晚了，但我去年费了很大劲才找到以下代码，可以返回用户名（“fGetUserName（）”）或全名（“DragUserName（）”）。您甚至不需要知道ad/dc地址

希望这对任何咨询这个问题的人都有帮助

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
 ' 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

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 = 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))
        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

---

此函数用于返回已登录用户的全名：

Function UserNameOffice() As String
    UserNameOffice = Application.UserName
End Function

---

如果用户在本地登录，则该方法有效，但在某些情况下，用户可以使用与其Windows用户名不同的用户名登录VPN。在这些情况下，我需要VPN用户名。谢谢你！如果您在VPN内执行VBA代码，您将获得VPN用户名，而不是您的本地用户。鲁本，谢谢您的建议。如果我理解正确，您的意思是我应该远程存储和运行外接程序。不幸的是，我必须在本地运行它。对不起，也许我遗漏了什么；你能详细说明一下你的VPN方案吗？当然。我只是在我的系统上安装了一个VPN客户端。我使用分配给我的用户名连接VPN，但用户名与我的Windows用户名不同。连接VPN后，所有应用程序都可以连接到相关服务器，否则无法连接。VPN没有覆盖Windows身份验证，尽管我知道这是可能的。当VPN连接时，我需要检索VPN用户名。我已经尝试了

Lib“advapi32.dll”Alias“GetUserNameA”

（），但通过VPN登录时返回NULL。我的问题部分由回答。看起来，虽然我通过VPN登录到网络，但我没有登录到Active Directory。因此，任何检索广告用户名的方法都将失败。我还没有找到任何方法从VPN客户端本身查询用户名。Kuyenda，我知道已经有一段时间了。但请看看我的答案。我认为这是最合适的，因为我表明，确实可以获取当前登录用户的名称。DragUserName（）将获取用户的实际名称，而fGetUserName（）将获取登录用户的Lan ID。这就是我需要知道的：“Active Directory本身不知道是否有人登录。”谢谢Nalandial！很好-只是一个简单的观点。。在DragUserName中，您需要检查可选用户名：

如果strUserName=“”，则strUserName=fGetUserName（）

+1工作正常，比通常的建议快得多。谢谢除非我弄错了，否则只显示安装Excel并在用户框中输入用户名的用户的用户名。不一定是登录用户。