Question

使用 Office 2013 ，我尝试插入VBA代码以自动输入员工姓名，因为它显示在任何Office产品右上角的单元格B2中他们打开excel电子表格。我正在使用的当前代码是

Sub Auto_Open()

    Range("B2").Value = " " & Application.UserName

End Sub

然而，这只是让它显示＆＃34;授权用户＆＃34;。
我做错了什么？

enter image description here

Answer 1

我今天早上开玩笑。我认为如果它不能作为Excel对象模型的一部分访问，则必须将此信息存储在注册表中的某处。这是有道理的，特别是如果此用户名是公司订阅的一部分。

注册表项

我在注册表中搜索了我的用户名如何显示在Excel中，然后弹出。

FriendlyName正是我的用户名在Excel中显示的方式。所以我们现在需要的是一种读取此注册表项FriendlyName的方法，并且应该这样做：）

<强>代码

以下是一些基于此密钥位置的代码。您的计算机可能略有不同，因此您可能需要调整此内容以查找FriendlyName

Private Function GetFriendlyName() As String
On Error GoTo ErrorHandler:

    Const HKEY_CURRENT_USER = &H80000001
    Const ComputerName As String = "."

    Dim CPU                 As Object
    Dim RegistryKeyPath     As String
    Dim RegistrySubKeys()   As Variant
    Dim RegistryValues()    As Variant
    Dim SubKeyName          As Variant
    Dim SubKeyValue         As Variant
    Dim KeyPath             As String

    GetFriendlyName = vbNullString

    Set CPU = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & ComputerName & "\root\default:StdRegProv")

    'Specify where to look
    RegistryKeyPath = "Software\Microsoft\Office\" & Application.Version & "\Common\Identity\Identities"

    'Enumerate the registry keys
    CPU.EnumKey HKEY_CURRENT_USER, RegistryKeyPath, RegistrySubKeys

    'Iterate each key in the identities folder
    For Each SubKeyName In RegistrySubKeys

        'Get each value in that folder
        CPU.EnumValues HKEY_CURRENT_USER, RegistryKeyPath & "\" & SubKeyName, RegistryValues

        'Go through each value, and find the Friendly Name
        For Each SubKeyValue In RegistryValues

            If SubKeyValue = "FriendlyName" Then
                KeyPath = "HKEY_CURRENT_USER\" & RegistryKeyPath & "\" & SubKeyName & "\" & SubKeyValue

                'Read the key
                With CreateObject("Wscript.Shell")
                    GetFriendlyName = .RegRead(KeyPath)
                End With

                Exit Function
            End If

        Next

    Next

CleanExit:
    Exit Function

ErrorHandler:
    'Handle errors here
    Resume CleanExit
End Function

'Run this to see the output in the immediate window
Private Sub ExampleUsage()
    Debug.Print "The friendly name is: " & GetFriendlyName
End Sub

<强>结果

The friendly name is: Ryan A. Wildry

Answer 2

试试这个：

Sub Auto_Open()
Dim Username As String
Dim path As String
Dim sourcefile As String
Dim objFso As FileSystemObject

Set objFso = CreateObject("Scripting.FileSystemObject")

If objFso.FileExists(path & " ~$" & sourcefile) Then
    Username = Split(GetFileOwner(path, " ~$" & sourcefile), "\")(1)
    Range("B2").Value = " " & Username
Else
    MsgBox ("File not Found!")
End If
End Sub

在打开的单元格中显示Excel帐户用户名

2 个答案: