当前位置：文江博客话题详情

vba

VBA 检索与记录的用户名关联的用户名

发布于 2024-12-11 02:50:31 字数 181 浏览 0 评论 0 原文

我想在 VBA 中获取用户（已登录）的全名。我在网上找到的这段代码可以获取用户名：

UserName = Environ("USERNAME")

但我想要用户的真实姓名。我发现了一些有关 NetUserGetInfo 的提示，但不知道该想什么或做什么。任何提示将不胜感激问候，

原文

I want to get the full name of the user (logged in already) in VBA. This code I found online would do getting the username:

UserName = Environ("USERNAME")

but I want the user's real name. I found some hint about NetUserGetInfo but not sure what to think or do. Any hints will be appreciated
Regards,

分享到QQ

分享到微博

如果你对这篇内容有疑问，欢迎到本站社区发帖提问参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

发布评论

需要登录才能够评论，你可以免费注册一个本站的账号。

只有影子陪我不离不弃 2024-12-18 02:50:31

即使这个线程相当旧，其他用户可能仍在谷歌搜索（像我一样）。
我找到了一个非常适合我的开箱即用的简短解决方案（感谢 Mr.Excel.com ）。
我更改了它，因为我需要它返回带有用户全名的字符串。
原始帖子是此处。

编辑：
好吧，我修正了一个错误，“End Sub”而不是“End Function”，并添加了一个变量声明语句，以防万一。我在Excel 2010和2013版本中进行了测试。在我的家用电脑上也运行良好（没有域，只是在工作组中）。

' This function returns the full name of the currently logged-in user
Function GetUserFullName() as String
    Dim WSHnet, UserName, UserDomain, objUser
    Set WSHnet = CreateObject("WScript.Network")
    UserName = WSHnet.UserName
    UserDomain = WSHnet.UserDomain
    Set objUser = GetObject("WinNT://" & UserDomain & "/" & UserName & ",user")
    GetUserFullName = objUser.FullName
End Function

Even if this thread is rather old, other users might be still googling around (like me).
I found an excellent short solution that worked for me out-of-the-box (thanks to Mr.Excel.com).
I changed it because I needed it to return a string with the user's full name.
The original post is here.

EDIT:
Well, I fixed a mistake, "End Sub" instead of "End Function" and added a variable declaration statement, just in case. I tested it in Excel 2010 and 2013 versions. Worked fine on my home pc too (no domain, just in a workgroup).

' This function returns the full name of the currently logged-in user
Function GetUserFullName() as String
    Dim WSHnet, UserName, UserDomain, objUser
    Set WSHnet = CreateObject("WScript.Network")
    UserName = WSHnet.UserName
    UserDomain = WSHnet.UserDomain
    Set objUser = GetObject("WinNT://" & UserDomain & "/" & UserName & ",user")
    GetUserFullName = objUser.FullName
End Function

回复收藏 0 原文

两仪 2024-12-18 02:50:31

我发现 API 答案也很复杂，除了需要从表单到模块重新编码之外，

下面的函数由 Rob Sampson 提供，来自专家交流帖子。这是一个灵活的功能，详细信息请参见代码注释。请注意，这是一个 vbscript，因此变量没有标注尺寸

Sub Test()
    strUser = InputBox("Please enter a username:")
    struserdn = Get_LDAP_User_Properties("user", "samAccountName", strUser, "displayName")
    If Len(struserdn) <> 0 Then
        MsgBox struserdn
    Else
        MsgBox "No record of " & strUser
    End If
End Sub

Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)

' This is a custom function that connects to the Active Directory, and returns the specific
' Active Directory attribute value, of a specific Object.
' strObjectType: usually "User" or "Computer"
' strSearchField: the field by which to seach the AD by. This acts like an SQL Query's WHERE clause.
'             It filters the results by the value of strObjectToGet
' strObjectToGet: the value by which the results are filtered by, according the strSearchField.
'             For example, if you are searching based on the user account name, strSearchField
'             would be "samAccountName", and strObjectToGet would be that speicific account name,
'             such as "jsmith".  This equates to "WHERE 'samAccountName' = 'jsmith'"
' strCommaDelimProps: the field from the object to actually return.  For example, if you wanted
'             the home folder path, as defined by the AD, for a specific user, this would be
'             "homeDirectory".  If you want to return the ADsPath so that you can bind to that
'             user and get your own parameters from them, then use "ADsPath" as a return string,
'             then bind to the user: Set objUser = GetObject("LDAP://" & strReturnADsPath)

' Now we're checking if the user account passed may have a domain already specified,
' in which case we connect to that domain in AD, instead of the default one.
    If InStr(strObjectToGet, "\") > 0 Then
        arrGroupBits = Split(strObjectToGet, "\")
        strDC = arrGroupBits(0)
        strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")
        strObjectToGet = arrGroupBits(1)
    Else
        ' Otherwise we just connect to the default domain
        Set objRootDSE = GetObject("LDAP://RootDSE")
        strDNSDomain = objRootDSE.Get("defaultNamingContext")
    End If

    strBase = "<LDAP://" & strDNSDomain & ">"
    ' Setup ADO objects.
    Set adoCommand = CreateObject("ADODB.Command")
    Set ADOConnection = CreateObject("ADODB.Connection")
    ADOConnection.Provider = "ADsDSOObject"
    ADOConnection.Open "Active Directory Provider"
    adoCommand.ActiveConnection = ADOConnection


    ' Filter on user objects.
    'strFilter = "(&(objectCategory=person)(objectClass=user))"
    strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"

    ' Comma delimited list of attribute values to retrieve.
    strAttributes = strCommaDelimProps
    arrProperties = Split(strCommaDelimProps, ",")

    ' Construct the LDAP syntax query.
    strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
    adoCommand.CommandText = strQuery
    ' Define the maximum records to return
    adoCommand.Properties("Page Size") = 100
    adoCommand.Properties("Timeout") = 30
    adoCommand.Properties("Cache Results") = False

    ' Run the query.
    Set adoRecordset = adoCommand.Execute
    ' Enumerate the resulting recordset.
    strReturnVal = ""
    Do Until adoRecordset.EOF
        ' Retrieve values and display.
        For intCount = LBound(arrProperties) To UBound(arrProperties)
            If strReturnVal = "" Then
                strReturnVal = adoRecordset.Fields(intCount).Value
            Else
                strReturnVal = strReturnVal & vbCrLf & adoRecordset.Fields(intCount).Value
            End If
        Next
        ' Move to the next record in the recordset.
        adoRecordset.MoveNext
    Loop

    ' Clean up.
    adoRecordset.Close
    ADOConnection.Close
    Get_LDAP_User_Properties = strReturnVal

End Function

I found the API answer complex as well in addition to needing recoding from a form to module

The function below comes courtesy of Rob Sampson from this Experts-Exchange post. It is a flexible function, see code comments for details. Please note it was a vbscript so the variables are not dimensioned

Sub Test()
    strUser = InputBox("Please enter a username:")
    struserdn = Get_LDAP_User_Properties("user", "samAccountName", strUser, "displayName")
    If Len(struserdn) <> 0 Then
        MsgBox struserdn
    Else
        MsgBox "No record of " & strUser
    End If
End Sub

Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)

' This is a custom function that connects to the Active Directory, and returns the specific
' Active Directory attribute value, of a specific Object.
' strObjectType: usually "User" or "Computer"
' strSearchField: the field by which to seach the AD by. This acts like an SQL Query's WHERE clause.
'             It filters the results by the value of strObjectToGet
' strObjectToGet: the value by which the results are filtered by, according the strSearchField.
'             For example, if you are searching based on the user account name, strSearchField
'             would be "samAccountName", and strObjectToGet would be that speicific account name,
'             such as "jsmith".  This equates to "WHERE 'samAccountName' = 'jsmith'"
' strCommaDelimProps: the field from the object to actually return.  For example, if you wanted
'             the home folder path, as defined by the AD, for a specific user, this would be
'             "homeDirectory".  If you want to return the ADsPath so that you can bind to that
'             user and get your own parameters from them, then use "ADsPath" as a return string,
'             then bind to the user: Set objUser = GetObject("LDAP://" & strReturnADsPath)

' Now we're checking if the user account passed may have a domain already specified,
' in which case we connect to that domain in AD, instead of the default one.
    If InStr(strObjectToGet, "\") > 0 Then
        arrGroupBits = Split(strObjectToGet, "\")
        strDC = arrGroupBits(0)
        strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")
        strObjectToGet = arrGroupBits(1)
    Else
        ' Otherwise we just connect to the default domain
        Set objRootDSE = GetObject("LDAP://RootDSE")
        strDNSDomain = objRootDSE.Get("defaultNamingContext")
    End If

    strBase = "<LDAP://" & strDNSDomain & ">"
    ' Setup ADO objects.
    Set adoCommand = CreateObject("ADODB.Command")
    Set ADOConnection = CreateObject("ADODB.Connection")
    ADOConnection.Provider = "ADsDSOObject"
    ADOConnection.Open "Active Directory Provider"
    adoCommand.ActiveConnection = ADOConnection


    ' Filter on user objects.
    'strFilter = "(&(objectCategory=person)(objectClass=user))"
    strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"

    ' Comma delimited list of attribute values to retrieve.
    strAttributes = strCommaDelimProps
    arrProperties = Split(strCommaDelimProps, ",")

    ' Construct the LDAP syntax query.
    strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
    adoCommand.CommandText = strQuery
    ' Define the maximum records to return
    adoCommand.Properties("Page Size") = 100
    adoCommand.Properties("Timeout") = 30
    adoCommand.Properties("Cache Results") = False

    ' Run the query.
    Set adoRecordset = adoCommand.Execute
    ' Enumerate the resulting recordset.
    strReturnVal = ""
    Do Until adoRecordset.EOF
        ' Retrieve values and display.
        For intCount = LBound(arrProperties) To UBound(arrProperties)
            If strReturnVal = "" Then
                strReturnVal = adoRecordset.Fields(intCount).Value
            Else
                strReturnVal = strReturnVal & vbCrLf & adoRecordset.Fields(intCount).Value
            End If
        Next
        ' Move to the next record in the recordset.
        adoRecordset.MoveNext
    Loop

    ' Clean up.
    adoRecordset.Close
    ADOConnection.Close
    Get_LDAP_User_Properties = strReturnVal

End Function

回复收藏 0 原文

帅冕 2024-12-18 02:50:31

这对我有用。它可能需要一些调整 - 我收到了几件退回的物品，但只有一件有 .Flags > 0

Function GetUserFullName() As String
    Dim objWin32NLP As Object
    On Error Resume Next
    ' Win32_NetworkLoginProfile class  https://msdn.microsoft.com/en-us/library/aa394221%28v=vs.85%29.aspx
    Set objWin32NLP = GetObject("WinMgmts:").InstancesOf("Win32_NetworkLoginProfile")
    If Err.Number <> 0 Then
      MsgBox "WMI is not installed", vbExclamation, "Windows Management Instrumentation"
      Exit Function
    End If
    For Each objItem In objWin32NLP
       If objItem.Flags > 0 Then GetUserFullName = objItem.FullName
    Next
End Function

This works for me. It might need some adjustments - I get several items returned and only one has .Flags > 0

Function GetUserFullName() As String
    Dim objWin32NLP As Object
    On Error Resume Next
    ' Win32_NetworkLoginProfile class  https://msdn.microsoft.com/en-us/library/aa394221%28v=vs.85%29.aspx
    Set objWin32NLP = GetObject("WinMgmts:").InstancesOf("Win32_NetworkLoginProfile")
    If Err.Number <> 0 Then
      MsgBox "WMI is not installed", vbExclamation, "Windows Management Instrumentation"
      Exit Function
    End If
    For Each objItem In objWin32NLP
       If objItem.Flags > 0 Then GetUserFullName = objItem.FullName
    Next
End Function

回复收藏 0 原文

并安 2024-12-18 02:50:31

尝试这个：

如何从 Visual Basic 调用 NetUserGetInfo

（来自 Microsoft 知识库，文章 ID 151774）

NetUserGetInfo 函数是仅支持 Unicode 的 Windows NT API。该函数的最后一个参数是一个指向结构的指针，该结构的成员包含 DWORD 数据和指向 Unicode 字符串的指针。为了从 Visual Basic 应用程序中正确调用此函数，您需要取消引用该函数返回的指针，然后需要将 Visual Basic 字符串转换为 Unicode 字符串，反之亦然。本文通过一个调用 NetUserGetInfo 从 Visual Basic 应用程序检索 USER_INFO_3 结构的示例来说明这些技术。

下面的示例使用 Win32 RtlMoveMemory 函数来取消引用 NetUserGetInfo 调用返回的指针。

分步示例

启动 Visual Basic。如果 Visual Basic 已在运行，请从“文件”菜单中选择“新建项目”。默认情况下会创建 Form1。
向 Form1 添加命令按钮 Command1。
将以下代码添加到 Form1 的一般声明部分：

文章中未具体声明的

' 定义：

' 服务器名和用户名参数也可以声明为长整型，
' 并使用 StrPtr 函数传递 Unicode 内存地址。
私有声明函数 NetUserGetInfo Lib“netapi32”_
                              （ByVal 服务器名称作为字符串，_
                              ByVal 用户名 As String, _
                              ByVal 级别 As Long, _
                              bufptr 只要) 只要

常量 NERR_Success = 0

私有声明子 MoveMemory Lib“kernel32”别名 _
      “RtlMoveMemory”（pDest 任意、pSource 任意、ByVal dwLength 任意）

私有声明函数 lstrlenW Lib "kernel32" (lpString As Any) As Long

' 将 Unicode 字符串转换为 ANSI 字符串
' 为 cchWideChar 指定 -1，为 cchMultiByte 指定 0，以返回字符串长度。
私有声明函数 WideCharToMultiByte Lib“kernel32”_
                           （ByVal 代码页只要，_
                           ByVal dwFlags 只要，_
                           lpWideCharStr 为任意，_
                           ByVal cchWideChar 只要长，_
                           lpMultiByteStr As Any, _
                           ByVal cchMultiByte 只要，_
                           ByVal lpDefaultChar 作为字符串，_
                           ByVal lpUsedDefaultChar 只要) 只要


私有声明函数 NetApiBufferFree Lib“netapi32”_
         （ByVal 缓冲区只要）只要

' 代码页
const CP_ACP = 0 ' ANSI 代码页

私有类型 USER_INFO_3
   usri3_name 只要 SDK 中的 'LPWSTR
   usri3_password 只要 SDK 中的 'LPWSTR
   usri3_password_age 只要 SDK 中的 'DWORD
   usri3_priv 只要 SDK 中的 'DWORD
   usri3_home_dir 只要 SDK 中的 'LPWSTR
   usri3_comment 只要 SDK 中的 'LPWSTR
   usri3_flags 只要 SDK 中的 'DWORD
   usri3_script_path 只要 SDK 中的 'LPWSTR
   usri3_auth_flags 只要 SDK 中的 'DWORD
   usri3_full_name 只要 SDK 中的 'LPWSTR
   usri3_usr_comment 只要 SDK 中的 'LPWSTR
   usri3_parms 只要 SDK 中的 'LPWSTR
   usri3_workstations 只要 SDK 中的 'LPWSTR
   usri3_last_logon 只要 SDK 中的 'DWORD
   usri3_last_logoff 只要 SDK 中的 'DWORD
   usri3_acct_expires 只要 SDK 中的 'DWORD
   usri3_max_storage 只要 SDK 中的 'DWORD
   usri3_units_per_week 只要 SDK 中的 'DWORD
   usri3_logon_hours 只要 SDK 中的 'PBYTE
   usri3_bad_pw_count 只要 SDK 中的 'DWORD
   usri3_num_logons 只要 SDK 中的 'DWORD
   usri3_logon_server 只要 SDK 中的 'LPWSTR
   usri3_country_code 只要 SDK 中的 'DWORD
   usri3_code_page 只要 SDK 中的 'DWORD
   usri3_user_id 只要 SDK 中的 'DWORD
   usri3_primary_group_id 只要 SDK 中的 'DWORD
   usri3_profile 只要 SDK 中的 'LPWSTR
   usri3_home_dir_drive 只要 SDK 中的 'LPWSTR
   usri3_password_expired 只要 SDK 中的 'DWORD
末端类型


私有子Command1_Click()
调暗 lpBuf 只要
将 ui3 调暗为 USER_INFO_3

' 将“管理员”替换为有效的 Windows NT 用户名。
If (NetUserGetInfo("", StrConv("管理员", vbUnicode), 3, _
uf) = NERR_Success) 然后
   调用 MoveMemory(ui3, ByVal lpBuf, Len(ui3))

   MsgBox GetStrFromPtrW(ui3.usri3_name)

   调用 NetApiBufferFree(ByVal lpBuf)
结束如果

结束子

' 从指向 Unicode 字符串的指针返回 ANSI 字符串。

公共函数 GetStrFromPtrW(lpszW As Long) As String
将 sRtn 调暗为字符串

sRtn = String$(lstrlenW(ByVal lpszW) * 2, 0) ' 2 字节/字符

' WideCharToMultiByte 还返回 Unicode 字符串长度
' sRtn = String$(WideCharToMultiByte(CP_ACP, 0, ByVal lpszW, -1, 0, 0, 0, 0), 0)

调用 WideCharToMultiByte(CP_ACP, 0, ByVal lpszW, -1, ByVal sRtn, Len(sRtn), 0, 0)
GetStrFromPtrW = GetStrFromBufferA(sRtn)

结束功能

' 返回 ANSI 字符串中遇到的第一个空字符（如果有）之前的字符串。

公共函数 GetStrFromBufferA(sz As String) As String
如果 InStr(sz, vbNullChar) 那么
   GetStrFromBufferA = Left$(sz, InStr(sz, vbNullChar) - 1)
别的
   ' 如果 sz 没有空字符，则 Left$ 函数
   '上面将返回零长度字符串（“”）。
   GetStrFromBufferA = sz
结束如果
结束功能

我建议将其重新分解到模块中，而不是将其嵌入到表单本身中。我过去曾在 Access 中成功使用过此功能。

Try this:

How To Call NetUserGetInfo from Visual Basic

(From Microsoft Knowledge Base, article ID 151774)

The NetUserGetInfo function is a Unicode-only Windows NT API. The last parameter of this function is a pointer to a pointer to a structure whose members contain DWORD data and pointers to Unicode strings. In order to call this function correctly from a Visual Basic application, you need to de-reference the pointer returned by the function and then you need to convert the Visual Basic string to a Unicode string and vice versa. This article illustrates these techniques in an example that calls NetUserGetInfo to retrieve a USER_INFO_3 structure from a Visual Basic application.

The example below uses the Win32 RtlMoveMemory function to de-reference the pointer returned by the NetUserGetInfo call.

Step-by-Step Example

Start Visual Basic. If Visual Basic is already running, from the File menu, choose New Project. Form1 is created by default.
Add a Command button, Command1, to Form1.
Add the following code to the General Declarations section of Form1:

' definitions not specifically declared in the article:

' the servername and username params can also be declared as Longs,
' and passed Unicode memory addresses with the StrPtr function.
Private Declare Function NetUserGetInfo Lib "netapi32" _
                              (ByVal servername As String, _
                              ByVal username As String, _
                              ByVal level As Long, _
                              bufptr As Long) As Long

Const NERR_Success = 0

Private Declare Sub MoveMemory Lib "kernel32" Alias _
      "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)

Private Declare Function lstrlenW Lib "kernel32" (lpString As Any) As Long

' Converts a Unicode string to an ANSI string
' Specify -1 for cchWideChar and 0 for cchMultiByte to return string length.
Private Declare Function WideCharToMultiByte Lib "kernel32" _
                           (ByVal codepage As Long, _
                           ByVal dwFlags As Long, _
                           lpWideCharStr As Any, _
                           ByVal cchWideChar As Long, _
                           lpMultiByteStr As Any, _
                           ByVal cchMultiByte As Long, _
                           ByVal lpDefaultChar As String, _
                           ByVal lpUsedDefaultChar As Long) As Long


Private Declare Function NetApiBufferFree Lib "netapi32" _
         (ByVal Buffer As Long) As Long

' CodePage
Const CP_ACP = 0        ' ANSI code page

Private Type USER_INFO_3
   usri3_name As Long              'LPWSTR in SDK
   usri3_password As Long          'LPWSTR in SDK
   usri3_password_age As Long      'DWORD in SDK
   usri3_priv As Long              'DWORD in SDK
   usri3_home_dir As Long          'LPWSTR in SDK
   usri3_comment As Long           'LPWSTR in SDK
   usri3_flags As Long             'DWORD in SDK
   usri3_script_path As Long       'LPWSTR in SDK
   usri3_auth_flags As Long        'DWORD in SDK
   usri3_full_name As Long         'LPWSTR in SDK
   usri3_usr_comment As Long       'LPWSTR in SDK
   usri3_parms As Long             'LPWSTR in SDK
   usri3_workstations As Long      'LPWSTR in SDK
   usri3_last_logon As Long        'DWORD in SDK
   usri3_last_logoff As Long       'DWORD in SDK
   usri3_acct_expires As Long      'DWORD in SDK
   usri3_max_storage As Long       'DWORD in SDK
   usri3_units_per_week As Long    'DWORD in SDK
   usri3_logon_hours As Long       'PBYTE in SDK
   usri3_bad_pw_count As Long      'DWORD in SDK
   usri3_num_logons As Long        'DWORD in SDK
   usri3_logon_server As Long      'LPWSTR in SDK
   usri3_country_code As Long      'DWORD in SDK
   usri3_code_page As Long         'DWORD in SDK
   usri3_user_id As Long           'DWORD in SDK
   usri3_primary_group_id As Long  'DWORD in SDK
   usri3_profile As Long           'LPWSTR in SDK
   usri3_home_dir_drive As Long    'LPWSTR in SDK
   usri3_password_expired As Long  'DWORD in SDK
End Type


Private Sub Command1_Click()
Dim lpBuf As Long
Dim ui3 As USER_INFO_3

' Replace "Administrator" with a valid Windows NT user name.
If (NetUserGetInfo("", StrConv("Administrator", vbUnicode), 3, _
uf) = NERR_Success) Then
   Call MoveMemory(ui3, ByVal lpBuf, Len(ui3))

   MsgBox GetStrFromPtrW(ui3.usri3_name)

   Call NetApiBufferFree(ByVal lpBuf)
End If

End Sub

' Returns an ANSI string from a pointer to a Unicode string.

Public Function GetStrFromPtrW(lpszW As Long) As String
Dim sRtn As String

sRtn = String$(lstrlenW(ByVal lpszW) * 2, 0)   ' 2 bytes/char

' WideCharToMultiByte also returns Unicode string length
'  sRtn = String$(WideCharToMultiByte(CP_ACP, 0, ByVal lpszW, -1, 0, 0, 0, 0), 0)

Call WideCharToMultiByte(CP_ACP, 0, ByVal lpszW, -1, ByVal sRtn, Len(sRtn), 0, 0)
GetStrFromPtrW = GetStrFromBufferA(sRtn)

End Function

' Returns the string before first null char encountered (if any) from an ANSI string.

Public Function GetStrFromBufferA(sz As String) As String
If InStr(sz, vbNullChar) Then
   GetStrFromBufferA = Left$(sz, InStr(sz, vbNullChar) - 1)
Else
   ' If sz had no null char, the Left$ function
   ' above would return a zero length string ("").
   GetStrFromBufferA = sz
End If
End Function

I would recommend re-factoring this into a module rather than embedding it in the form itself. I've used this successfully in Access in the past.

回复收藏 0 原文

余生再见 2024-12-18 02:50:31

我已经尝试了很多事情，但我想我的组织不允许我查询 Active Directory（或者我的结构错误）。我只能获取我的帐户名称（不是全名）或错误“帐户名称和安全 ID 之间没有完成映射”

但是经过 2 周的搜索，我终于有了一个我想要的可行解决方案分享。我的最终提示可以在这里找到： https://www.mrexcel.com/board/threads/application-username-equivalent-in-ms-access.1143798/page-2#post-5545265

该值确实出现在注册表中，即
“HKEY_CURRENT_USER\Software\Microsoft\Office\Common\UserInfo\用户名”

一旦我意识到这一点，使用 VBA 访问就很容易了：

UserName = CreateObject("wscript.shell").RegRead("HKEY_CURRENT_USER\Software\Microsoft\Office\Common\UserInfo\UserName")

我假设（但没有测试）这就是 Application.Username来自 Excel 的使用也是如此。可能并不完美，但我终于有了一个可行的解决方案。

I've tried so many things, but I suppose my organization does not allow me to query Active Directory (or I got the structure wrong). I could only get my account name (not full name) or the error "No mapping between account names and security IDs was done"

But after 2 weeks searching, I finally have a working solution that I wanted to share. My final hint can be found here: https://www.mrexcel.com/board/threads/application-username-equivalent-in-ms-access.1143798/page-2#post-5545265

The value does appear in the registry i.e.
"HKEY_CURRENT_USER\Software\Microsoft\Office\Common\UserInfo\UserName"

Once I realized that, it was easy to access with VBA:

UserName = CreateObject("wscript.shell").RegRead("HKEY_CURRENT_USER\Software\Microsoft\Office\Common\UserInfo\UserName")

I assume (did not test though) that this is what Application.Username from Excel uses as well. Might not be perfect, but I finally have a solution that works.

回复收藏 0 原文