以管理员身份运行命令提示符命令

3
我可以使用以下代码在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

1
我已经编辑了你的标题。请参考“问题的标题应该包含“标签”吗?”,在那里达成共识是“不应该”。 - John Saunders
ShellExecute可以工作,你能发一下你尝试过的吗? - Bill Dinger
1
可能是 http://stackoverflow.com/questions/11508724/opening-a-file-in-administrator-mode-from-excel-vba-in-windows-07 的重复问题。 - peege
3个回答

0

嗯,我可能有点晚了!说出来只是为了记录 :) 尝试回答同样的问题,我阅读的其他主题没有提到vba,所以我在这里提出一种方法来完成它。

  • 功能:从VBA运行wsshl,打开一个cmd提示符来测试当前用户权限,如果不是管理员,则打开一个powershell窗口,以管理员模式打开一个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") & "\Desktop\test.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

0

你正在做的应该可以工作。这是我使用过的一个辅助工具。

Private Sub RunAsAdmin(ByVal command As String, ByVal parameters As String)
    ShellExecute 0, "runas", command, parameters, vbNullString, SW_SHOWNORMAL
End Sub

-1

这个VBScript与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

运行RunAs会提示输入密码吗? - Morettz

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接