vba - 在 Excel VBA 中获取登录用户名 - 不是运行 Excel 的帐户(使用 RunAs)

Question

我已使用正常的域凭据登录到我的工作站。我们将此称为 AccountA。

然后，我使用“以其他用户身份运行”来启动 Excel。我们将此称为AccountB。我这样做是因为查询某些 SQL 服务器所需的权限必须使用 AccountB 来完成。

此时，我需要包含一个子例程来启动 Shell，以在远程服务器上创建目录和移动文件。 AccountB 没有(也不可能有)执行此操作的权限。我的 shell 给我一条拒绝访问的消息。美好的。

现在，我需要让 VBA 返回 AccountA 的名称，即我用来登录计算机的帐户。我该怎么做呢？

我在这个网站以及其他网站上看到了很多示例，这些示例将返回运行 Excel 的用户名 (AccountB)。但是，我还没有看到任何示例可以提取 AccountA 信息并通过 RunAs 传递到 Shell，以使用适当的权限执行我的命令。以下是我尝试过的一些操作，全部返回 AccountB(通过 RunAs 用于启动 Excel 的帐户)

此应用程序将由多个有权在远程服务器上运行 cmd shell 的人使用，因此 AccountA 不能进行硬编码，必须以编程方式获取。

' Access the GetUserNameA function in advapi32.dll and
' call the function GetUserName.
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long

Sub XXXXXXXXXX()
'//
ThisWorkbook.Sheets("XXXXXXXXXX").Activate ' select the worksheet for use
cmdString = UCase(Trim(ThisWorkbook.ActiveSheet.Cells(4, 4).Value)) 'get XXXXXXXXXX

'MsgBox cmdString
'retval = Shell("cmd.exe /k " & cmdString, vbNormalNoFocus)
'cmdString = "MkDir \\XXXXXXXXXX\g$\Tempski" 'fails - no permission

'Set the Domain
txtdomain = "XXXXXXXXXX"
'Acquire the currently logged on user account
'txtuser = "XXXXXXXXXX"

 ' Dimension variables
 Dim lpBuff As String * 255
 Dim ret As Long

 ' Get the user name minus any trailing spaces found in the name.
 ret = GetUserName(lpBuff, 255)

 If ret > 0 Then
 GetLogonName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
 Else
 GetLogonName = vbNullString
 End If

MsgBox GetLogonName

Dim objNet As Object
On Error Resume Next
Set objNet = CreateObject("WScript.NetWork")
MsgBox "Network username is: " & objNet.UserName
Set objNet = Nothing

MsgBox "Environ username is: " & Environ("USERNAME")

MsgBox "Application username is: " & Application.UserName    
MsgBox "Network username is: " & WindowsUserName

Dim strUser As String
strUser = ActiveDirectory.user()
MsgBox "Welcome back, " & strUser

CurrentWorkbenchUser = Environ("USERDOMAIN") & "\" & Environ("USERNAME")
MsgBox CurrentWorkbenchUser

Set WSHnet = CreateObject("WScript.Network")
UserName = WSHnet.UserName
UserDomain = WSHnet.UserDomain
Set objUser = GetObject("WinNT://" & UserDomain & "/" & UserName & ",user")
GetUserFullName = objUser.FullName

MsgBox GetFullUserName

'//try to pass user credentials to shell - service account cannot run XXXXXXXXXX
'//This Works when txtdomain and txtuser are passed properly (MUST GRAB THESE SOMEHOW)
'retval = Shell("runas /user:" & txtdomain & "\" & txtuser & " ""cmd.exe /k dir /s *.*""", vbNormalFocus)

End Sub

上面的所有代码都返回用于启动 Excel 的帐户 - 不是我需要的，即我用于登录计算机的帐户。

Answer 1

基本方法是使用“run as”参数执行 shell。

• 你看过this吗？
• 另请参阅 here

这是从 MS 视线中窃取的代码，只是为了确保下一个过来的人能够快速引用。

Sub RegisterFile(ByVal sFileName As String)
ShellExecute 0, "runas", "cmd", "/c regsvr32 /s " & """" & sFileName & """", "C:\", 0 'SW_HIDE =0
End Sub

顺便说一句，如果您只需要访问 SQL 服务器的帐户，您应该能够在 vba 宏的连接字符串中设置该帐户。我过去曾为 Oracle DB 做过这样的事情。