如何不通过CMD使用VBA获取Windows用户账户的当前用户全名？

我们团队在域环境下使用Windows设备协作处理Excel文件，无法通过OneDrive实现协作。为了跟踪文件编辑记录，我写了一段VBA代码，在每次保存文件时记录时间戳和当前用户。目前用Environ("Username")只能获取类似ID1234的Windows用户名，但所有用户账户都配置了更实用的全名（格式如(Company) Flash Steel）。之前通过调用CMD的net user命令解析输出的方式虽然可行，但希望用更优雅的原生VBA实现来替代。

原代码片段：

' When saving, append the user ID and timestamp
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    ...
    Worksheets("Front Cover").Range(nextTimestampCell).Value = Format(Now(), "yy/mm/dd - HH:nn:ss")
    ' Build string for command
    cMDcommand = "cmd /c net user """ & Environ("Username") & """ /DOMAIN | find /I ""Full name"""
    ' Execute command and read top line
    result = Trim(CreateObject("Wscript.Shell").Exec(cMDcommand).StdOut.readline)
    ' Trim result and output User
    Worksheets("Front Cover").Range(nextUserCell).Value = Right(result, Len(result) - 29)
End Sub

原生VBA解决方案 #

在域环境中，可以通过**ADSI（Active Directory Service Interfaces）**直接访问Active Directory获取用户全名，无需调用外部命令，更稳定高效。以下是两种实现方式：

方法1：使用ADsNameTranslate转换并获取用户信息 #

该方法先将用户名转换为LDAP路径，再绑定到用户对象读取全名：

Private Function GetDomainUserFullName() As String
    Dim objTrans As Object
    Dim objUser As Object
    Dim strUserName As String
    Dim strLDAPPath As String
    
    strUserName = Environ("Username")
    
    ' 初始化ADsNameTranslate对象
    Set objTrans = CreateObject("ADsNameTranslate")
    objTrans.Init 1, "" ' 1代表ADS_NAME_INITTYPE_DOMAIN，空字符串使用当前域
    objTrans.Set 3, strUserName ' 3代表ADS_NAME_TYPE_NT4格式（DOMAIN\用户名）
    
    ' 转换为LDAP路径格式
    strLDAPPath = objTrans.Get(1) ' 1代表ADS_NAME_TYPE_LDAP
    
    ' 绑定到用户对象并读取全名
    Set objUser = GetObject("LDAP://" & strLDAPPath)
    GetDomainUserFullName = objUser.FullName
    
    ' 释放对象
    Set objUser = Nothing
    Set objTrans = Nothing
End Function

方法2：直接通过用户Principal Name绑定 #

如果需要兼容本地账户，也可以直接构造用户路径读取信息：

Private Function GetDomainUserFullName() As String
    Dim objUser As Object
    Dim strDomain As String
    Dim strUserName As String
    
    strUserName = Environ("Username")
    strDomain = Environ("USERDOMAIN") ' 获取当前域
    
    ' 绑定到用户对象
    Set objUser = GetObject("WinNT://" & strDomain & "/" & strUserName & ",user")
    GetDomainUserFullName = objUser.FullName
    
    Set objUser = Nothing
End Function

整合到保存事件中 #

将上述函数替换原代码中调用CMD的部分，修改后的Workbook_BeforeSave如下：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim nextTimestampCell As Range
    Dim nextUserCell As Range
    Dim userFullName As String
    
    ' 假设此处已定义nextTimestampCell和nextUserCell的位置
    ' ...
    
    ' 记录时间戳
    Worksheets("Front Cover").Range(nextTimestampCell).Value = Format(Now(), "yy/mm/dd - HH:nn:ss")
    
    ' 获取用户全名
    userFullName = GetDomainUserFullName()
    
    ' 记录用户信息（获取失败时回退到用户名）
    Worksheets("Front Cover").Range(nextUserCell).Value = IIf(userFullName <> "", userFullName, Environ("Username"))
End Sub

注意事项 #

• 域环境下普通用户默认具备访问Active Directory的权限，无需额外配置
• 方法2兼容本地账户和域账户，适用性更广
• 原生ADSI方法避免了命令输出格式变化导致的解析错误，稳定性更强

内容的提问来源于stack exchange，提问作者Flash_Steel