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

Question

我使用普通的域凭据登录了我的工作站.我们称之为AccountA.

然后我使用"以其他用户身份运行"来启动Excel.我们称之为账户B. 我这样做是因为查询某些SQL服务器所需的权限必须使用AccountB完成.

此时,我需要包含一个子例程来启动Shell以创建目录并在远程服务器上移动文件.AccountB没有(也没有)权限来执行此操作.我的shell给了我一个拒绝访问的消息.精细.

所以现在,我需要让VBA返回AccountA的名称,这是我用来登录计算机的帐户.我该怎么做呢？

我在这个网站上看到了很多例子以及其他会返回运行Excel(AccountB)的用户名的例子.但是,我还没有看到任何将AccountA信息传递给Shell的示例,以通过RunAs适当的权限执行我的命令.以下是我尝试过的一些事情,都返回了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。

• 你看过这个吗
• 也看这里

这是从 MS 视线中盗取的代码，只是为了确保下一个过来的人可以快速参考。

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

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