VBA结合GetOject和GetUsername返回登录用户的实际名称而不是代码

Posted 2023-04-13

【中文标题】VBA结合GetOject和GetUsername返回登录用户的实际名称而不是代码

【英文标题】：VBA Combine GetOject and GetUsername to return actual name of logged on User instead of code

【发布时间】：2018-04-04 10:09:39

【问题描述】：

我有两个代码，第一个获取用户的全名（名字和姓氏）并在显示框中打印为“Doe，John”。

当他们双击定义范围内的单元格时，第二个获取用户 ID，并将 ID 打印为带有当前时间和日期的“A012345”。

我想将两者结合起来，而不是 "A012345 04/04/18 10:19:14" 我得到“Doe, John 04/04/18 10:19:14”

代码 1

Sub Username()
Set objAD = CreateObject("ADSystemInfo")
Set objUser = GetObject("LDAP://" & objAD.Username)
strDisplayName = objUser.DisplayName
MsgBox strDisplayName
End Sub

代码 2

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i
Dim Myrow As Integer
Dim lpBuff As String * 25
Dim ret As Long, Username As String

ret = GetUsername(lpBuff, 25)
Username = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)


i = Status

If Not Application.Intersect(Range("E6:N9000"), Target) Is Nothing Then
    If Target = "NA" Then
    Cancel = True
    Exit Sub

    Else
  If Target = vbNullString Then
    Target = Username & " " & Format(Now, "DD/MM/yy HH:MM:ss")
     Target.Interior.ColorIndex = 43
  Cancel = True
Else
    If Target <> vbNullString Then
        Target = ""
        Target.Interior.ColorIndex = 0
        Cancel = True
    End If
    End If
    End If
End If
End Sub

【问题讨论】：

你不需要匈牙利符号还有什么是GetUsername？顶部最初是您在底部调用的函数吗？

【参考方案1】：

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Set objAD = CreateObject("ADSystemInfo")
Set objUser = GetObject("LDAP://" & objAD.Username)
strDisplayName = objUser.DisplayName

If Not Application.Intersect(Range("E6:N9000"), Target) Is Nothing Then
    If Target = "NA" Then
        Cancel = True
        Exit Sub
    Else
        If Target = vbNullString Then
            Target = strDisplayName & " " & Format(Now, "DD/MM/yy HH:MM:ss")
            Target.Interior.ColorIndex = 43
            Cancel = True
        Else
            If Target <> vbNullString Then
                Target = ""
                Target.Interior.ColorIndex = 0
                Cancel = True
            End If
        End If
    End If
End If
End Sub

【参考方案2】：

也许？

Option Explicit

Public Function Username() As String

    Dim AD As Object
    Dim User As Object

    Set AD = CreateObject("ADSystemInfo")
    Set User = GetObject("LDAP://" & AD.Username)

     Username = User.DisplayName

End Function

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Not Application.Intersect(Range("E6:N9000"), Target) Is Nothing Then

        Select Case Target

        Case "NA"
            Cancel = True
            Exit Sub

        Case vbNullString
                Target = Username & " " & Format$(Now, "DD/MM/yy HH:MM:ss")
                Target.Interior.ColorIndex = 43

        Case Else
                Target = vbNullString
                Target.Interior.ColorIndex = 0

        End Select

        Cancel = True

    End If

End Sub