我可以使用以下代码在命令提示符窗口中从 vba 运行命令
Private Sub CMDTest()
'command for cmd to execute
Dim command As String
command = "dir"
Call Shell("cmd.exe /S /K" & command)
End Sub
但是,它不会以管理员权限运行。如果command
是需要管理权限的东西,我如何使用管理权限从 vba 运行它?
我尝试过ShellExecute
各种方式,但没有运气。我使用的代码如下,我可以以管理员身份打开命令提示符窗口,但不能运行dir
命令。
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1
Public Sub test()
ShellExecute 0, "runas", "cmd.exe", "", vbNullString, SW_SHOWNORMAL
End Sub
好吧,我可能会迟到!说这是为了记录:)试图回答同样的问题,我读过的其他主题没有提到 vba,所以我在这里提出一种方法。
-
它做什么:从 vba 运行 wsshl,打开一个 cmd 提示符进行测试当前用户权限,如果不是管理员,则会打开一个PowerShell窗口在管理模式下打开一个CMD提示符,该提示符运行一些cmd行参数。。。一气呵成(后期绑定,只是MSDOS)
-
诀窍:而不是运行外部批处理文件,否则,所有命令使用 DOS 和运算符在装配线中发送。
-
问题:VBA不会等待最后一个打开的cmd窗口(异步)所以我添加了...另一个CMD提示符充当"waitonrun"还要检查没有发生可怕的事情。如果没有需要等待或验证任何事情,它们可以被"释放"。
-
工作原理:在mycmd变量中输入cmd参数,它可以是使用 VBA 变量进行参数化,然后运行/编译。UAC 将提示以在管理员模式下打开CMD窗口,然后按照说明进行操作。
-
其他可能的用途:在 psmeth 2 中使用 psargsList="echo.",访问如果要键入,将授予最后一个cmd提示符(管理员模式)其他命令,而不是发送一堆参数。在这种情况下"waitonrun"提示允许暂停VBA,直到您完成。
下面是一个使用 icacls 收回文件所有权的示例。
Sub acmd()
'--------
'settings
'--------
Dim output As String: output = Environ("userprofile") & "Desktoptest.txt" ' a file
Dim mycmd As String: mycmd = "icacls " & output & " /grant %username%:F " 'an msdos cmd to run as admin
'---------
'2 methods
'---------
'exact same versions but different syntax, the first is shorter, the second uses -ArgumentList argument of powershell that can be usefull in other cases
'note: first run of powershell may take some time
Dim psmeth As Long: psmeth = 1 '2
Dim psargsList As String, psargs As String
'------
'layout
'------
'trying to lighten a bit the expression and the cmd prompt
'msg could also be other cmd arguments
Dim msg1 As String, msg2 As String, msg3 As String
msg1 = "echo.& echo.""- listing files with ownership"" & echo."
msg2 = "echo.& echo.""- applying cmd"" & echo.& echo. "
msg3 = "echo.& echo.""Done! now press [enter]"" & echo."
With CreateObject("wScript.Shell")
If psmeth = 1 Then
'add an msdos '&' between msdos args and cut the vba string with a vba '&' where you want to insert vba variables
'from the last cmd point of view it will be the same cmd line, a succession of cmd arg1 & arg2 & arg3, the 'encapsulation' between """" is a bit more tricky
'there are some warnings you can see when using -noexit after powershell cmd but it doesn't seems to hurt
psargs = msg1 & " & dir " & output & " /q & " & msg2 & " & " & mycmd & " & " & msg3 & " & pause"
.Run "cmd /c net session >nul 2>&1 & if ERRORLEVEL 1 ( Powershell -Command ""& { Start-Process cmd.exe """"/c " & psargs & """"" -verb RunAs -wait }"" )", 1, True ' 3rd win only? ok too; add -noexit after Powershell to see warnings
ElseIf psmeth = 2 Then
'based on same principle, it works also with powershell's -ArgumenList 'arg1','& arg2','& arg3',.. syntax, there is a little less escaping but it needs to open a '4th' cmd window with /k (and VBA wont wait for it!) so that it doesn't close and runs cmd line args in assembly line
'the cuts '...', are arbitrary, then inside them cut the vba string to insert vba variables
psargsList = "-ArgumentList 'cmd /k ','" & msg1 & " & echo. &','dir " & output & " /q ',' & echo. & " & msg2 & "',' & " & mycmd & " ','& " & msg3 & " & pause ','& exit'"
.Run "cmd /c net session >nul 2>&1 & if ERRORLEVEL 1 ( Powershell -Command ""& { Start-Process cmd.exe " & psargsList & " -verb RunAs -wait }"" )", 1, True
End If
If psmeth = 1 Or psmeth = 2 Then
'we need some 'waitonrun', here a simple confirmation window
.Run "cmd /c tasklist |find ""cmd.exe"" >nul && (set /p""= Holding on VBA till you close admin windows. Press [enter] when ready"" & taskkill /f /im ""cmd.exe"") || echo. ""dummy"">nul", 1, True
End If
End With
'------------------
Debug.Print "-end-"
'------------------
End Sub
你正在做的事情应该有效。这是我使用过的助手。
Private Sub RunAsAdmin(ByVal command As String, ByVal parameters As String)
ShellExecute 0, "runas", command, parameters, vbNullString, SW_SHOWNORMAL
End Sub
此 vbsscript 与 VBA 兼容,从文件上的右键单击菜单运行动词。程序具有 RunAs 以在其菜单上提升为管理员。
HelpMsg = vbcrlf & " ShVerb" & vbcrlf & vbcrlf & " David Candy 2014" & vbcrlf & vbcrlf & " Lists or runs an explorer verb (right click menu) on a file or folder" & vbcrlf & vbcrlf & " ShVerb <filename> [verb]" & vbcrlf & vbcrlf & " Used without a verb it lists the verbs available for the file or folder" & vbcrlf & vbcrlf
HelpMsg = HelpMsg & " The program lists most verbs but only ones above the first separator" & vbcrlf & " of the menu work when used this way" & vbcrlf & vbcrlf
HelpMsg = HelpMsg & " The Properties verb can be used. However the program has to keep running" & vbcrlf & " to hold the properties dialog open. It keeps running by displaying" & vbcrlf & " a message box."
Set objShell = CreateObject("Shell.Application")
Set Ag = WScript.Arguments
set WshShell = WScript.CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
If Ag.count = 0 then
wscript.echo " ShVerb - No file specified"
wscript.echo HelpMsg
wscript.quit
Else If Ag.count = 1 then
If LCase(Replace(Ag(0),"-", "/")) = "/h" or Replace(Ag(0),"-", "/") = "/?" then
wscript.echo HelpMsg
wscript.quit
End If
ElseIf Ag.count > 2 then
wscript.echo vbcrlf & " ShVerb - To many parameters" & vbcrlf & " Use quotes around filenames and verbs containing spaces" & vbcrlf
wscript.echo HelpMsg
wscript.quit
End If
If fso.DriveExists(Ag(0)) = True then
Set objFolder = objShell.Namespace(fso.GetFileName(Ag(0)))
' Set objFolderItem = objFolder.ParseName(fso.GetFileName(Ag(0)))
Set objFolderItem = objFolder.self
msgbox ag(0)
ElseIf fso.FolderExists(Ag(0)) = True then
Set objFolder = objShell.Namespace(fso.GetParentFolderName(Ag(0)))
Set objFolderItem = objFolder.ParseName(fso.GetFileName(Ag(0)))
ElseIf fso.fileExists(Ag(0)) = True then
Set objFolder = objShell.Namespace(fso.GetParentFolderName(Ag(0)))
Set objFolderItem = objFolder.ParseName(fso.GetFileName(Ag(0)))
Else
wscript.echo " ShVerb - " & Ag(0) & " not found"
wscript.echo HelpMsg
wscript.quit
End If
Set objVerbs = objFolderItem.Verbs
'If only one argument list verbs for that item
If Ag.count = 1 then
For Each cmd in objFolderItem.Verbs
If len(cmd) <> 0 then CmdList = CmdList & vbcrlf & replace(cmd.name, "&", "")
Next
wscript.echo mid(CmdList, 2)
'If two arguments do verbs for that item
ElseIf Ag.count = 2 then
For Each cmd in objFolderItem.Verbs
If lcase(replace(cmd, "&", "")) = LCase(Ag(1)) then
wscript.echo(Cmd.doit)
Exit For
End If
Next
'Properties is special cased. Script has to stay running for Properties dialog to show.
If Lcase(Ag(1)) = "properties" then
WSHShell.AppActivate(ObjFolderItem.Name & " Properties")
msgbox "This message box has to stay open to keep the " & ObjFolderItem.Name & " Properties dialog open."
End If
End If
End If