在Excel VBA中获取login用户名 – 不是运行Excel的帐户（使用RunAs）
我用我的普通域凭据login到了我的工作站。 我们称之为AccountA。
然后我使用“以其他用户身份运行”来启动Excel。 我们称之为AccountB。 我这样做是因为需要查询一些SQL服务器的权限必须使用AccountB完成。
此时，我需要包含一个子例程来启动一个Shell来创build目录并在远程服务器上移动文件。 AccountB没有（也没有）权限来执行此操作。 我的shell给我一个拒绝访问的消息。 精细。
所以现在，我需要让VBA返回AccountA的名字，这是我用来login到计算机的帐户。 我该怎么做呢？
我在这个网站上看到了很多例子，以及其他会返回运行Excel（AccountB）的用户名的例子。 但是，我还没有看到任何示例将通过RunAs将AccountA信息传递到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的帐户 – 不是我所需要的，即我用来login到计算机的帐户。
基本的方法是用“run as”参数执行shell。
- 你有没有看过这个
- 也看这里
这是从MS视线撕下的代码，只是在这里，以确保下一个人或join谁来有一个快速的参考。
Sub RegisterFile(ByVal sFileName As String) ShellExecute 0, "runas", "cmd", "/c regsvr32 /s " & """" & sFileName & """", "C:\", 0 'SW_HIDE =0 End Sub
另外，如果您只需要访问SQL服务器的帐户，您应该能够在vba MACRO中的连接string中设置该帐户。 我曾经为Oracle数据库做过这些工作。