Run command prompt commands as admin - vba

I can use the following code to run a command from vba in the command prompt window
Private Sub CMDTest()
'command for cmd to execute
Dim command As String
command = "dir"
Call Shell("cmd.exe /S /K" & command)
End Sub
However it does not run with admin privileges. If command was something that required administrative privileges, how can I run it from vba with administrative privileges?
I have tried to used ShellExecute various ways and have had no luck. The code I used is below, I can open the command prompt window as an admin, however can not run the dir command.
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

Well, I may be late! say it is for the record :) Trying to answer the same question, the other topics I've read do not mention vba so I propose here a way to do it.
What it does: run wsshl from vba that opens a cmd prompt that test
current user rights, if not admin then it opens a powershell window
that opens a cmd prompt in admin mode that runs some cmd line
arguments... in one go (late binding, just msdos)
The trick: instead of running an external batch file or else, all
command are send in assembly line using dos & operator.
The problem: VBA wont wait for the last opened cmd window
(asynchrone) so I added... another cmd prompt to serve as 'waitonrun'
but also to check that no terrible thing happened. If there is no
need to wait or verify anything, they can be 'released'.
How it works: Enter your cmd arguments in mycmd variable, it can be
parametrized with vba variables, and run/compile. the UAC will prompt
to open a cmd window in admin mode and then follow the instructions.
Other possible use: use psargsList="echo." in psmeth 2, access to
last cmd prompt (admin mode) will be granted if you want to type
other commands instead of sending a bunch of arguments. In that case
the 'waitonrun' prompt allow to pause vba until you finished.
Here an example to take back ownership of a file using 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

What you are doing should work. Here is a helper I have used.
Private Sub RunAsAdmin(ByVal command As String, ByVal parameters As String)
ShellExecute 0, "runas", command, parameters, vbNullString, SW_SHOWNORMAL
End Sub

This vbsscript, compatable with VBA, runs a verb from right click menu on a file. Programs have RunAs to elevate to admins on their menus.
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

Related

Keep Process.Start() From running at the same time

I am having a problem, i was doing files copy and then combine them into pdf file using "pdftk" from cmd.
i put the copy process into a nest loop to get the files i wanted. However, the combine process start at the same time as the copy process run which combines any file already copied. It should wait until the copy done then start the combine. Please help me with this
Private Sub PDF_Print(ProcessDir As String)
Dim i As Integer = 0
For i = 1 To CInt(txtNumofSet.Text)
Dim Labelcopy As String = "/c S: & cd ""S:\User Files\Shipping & Receiving\NewlyWeds labels\process"" & for /l %x in (1, 1, " & txtCopies.Text & ")" &
"do (copy """ & SourceFile & """ workarea\" & i & "S" & "%x.pdf)"
Dim Run = Process.Start("cmd.exe", Labelcopy)
Dim Blankcopy As String = "/c S: & cd ""S:\User Files\Shipping & Receiving\NewlyWeds labels\process"" & for /l %x in (1, 1, " & txtNumofblanks.Text & ")" &
"do (copy """ & ProcessDir & """ workarea\" & i & "SB" & "%x.pdf)"
Dim Run1 = Process.Start("cmd.exe", Blankcopy)
Next
Process.Start("S:\User Files\Shipping & Receiving\NewlyWeds labels\process\Label.cmd")
' Me.Close()
End Sub
Is there any ways to tell the last the Process.start to start after the first two finish running. Thank you.
You should use the .NET framework to copy the files, e.g. File.Copy
One can use the Process.HasExited Property to see if a process has completed. Here is a simple example:
Dim objProcess As Process = Process.Start("cmd.exe", Labelcopy)
Do Until objProcess.HasExited
System.Threading.Thread.Sleep(100)
Loop
Process.Start("S:\User Files\Shipping & Receiving\NewlyWeds labels\process\Label.cmd")

Using Excel VBA to run a CMD command

I would like to use Excel VBA to run a CMD command.
The basic cmd command is:
"C:\Program Files\example program.exe" -w C:\Program files\outputfile.file "dir1" "dir2" "dir n+1"
The first part is the location of the program that will merge the files together.
The second part is the file location of the outputted merged files.
And the "dir1".... is the files that will be merged together.
I have code that lists the files to be merged but struggling to get the CMD code to get it so it does what I want as mentioned above. I have tried the following:
Sub RunCMD()
Dim wsh As Object
Set wsh = VBA.CreateObject("WScript.Shell")
Dim waitOnReturn As Boolean: waitOnReturn = True
Dim windowStyle As Integer: windowStyle = 1
Dim locationofprogram as string
'dir of program that will do the merge
Dim outputfolder as string
'dir of where the merged file will go
Dim listoffiles as string
'list of files to be merged
wsh.Run "cmd.exe /S /C locationofprogram & " " & "-w" & " " & outputfolder & " " & listoffiles, windowStyle, waitOnReturn
End Sub
Thanks for the help!
You can always create a .bat file, run the file, then delete it.
MyFile = "C:\Bat-File\Bat-File.bat"
fnum = FreeFile()
Open MyFile For Output As #fnum
Print #fnum, "C:\Program Files\example program.exe -w C:\Program files\outputfile.file dir1 dir2 dir n+1"
Close #fnum
Shell MyFile, vbNormalFocus
' wait 10 seconds to let bat file finnish
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 10
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
' delete bat-file
kill MyFile
I can't test that example program runs without the " around the dirĀ“s so you have to see what happens.
But if it does not work you need to double enclose the " or use & CHR(34) &
If in doubt, send the text to the Immediate Window to see if it still matches the syntax using:
Debug.Print "cmd.exe /S /C " & locationofprogram & " " & "-w" & " " & outputfolder & " " & listoffiles
If that works, use:
wsh.Run "cmd.exe /S /C " & locationofprogram & " " & "-w" & " " & outputfolder & " " & listoffiles, windowStyle, waitOnReturn

VBA: How to Open command prompt as Administrator and call a VBS using cscript?

I'm trying to open a command prompt as Administrator AND run a .VBS file using CScript.
I found post for running cmd as Administrator:
Shell "powershell.exe -Command " & Chr(34) & "Start-Process cmd -Verb RunAs", vbNormalFocus
Also Found a post for running a VBS file:
SFilename = "Cscript " & Chr(34) & "C:\Temp\Run.vbs " & Chr(34) & " " & pParam1 & " " & pParam2
Shell SFilename, vbNormalFocus
However, Can someone help me to get both things done in single cmd window?
I tried merging both Shell statments and running one after the other but no luck.
Copying #Noodles answer in order to mark this question as answered:
Set oShell = CreateObject("Shell.Application")
oShell.ShellExecute "cscript.exe", "//nologo c:temp\run.vbs", , "runas", 1
or for cmd
oShell.ShellExecute "cmd.exe", "/k cscript //nologo c:temp\run.vbs", , "runas", 1

Opening an MS-Access database from the command line without running any of the startup vba code?

Is there a way to open an MS-Access 2003 database from the command line without running any of the startup vba code or displaying any errors?
I looked at the command line arguments for MS Access and there doesn't seem to be one for specifying that you want none of the vba code to execute on startup.
I'm using the following code to open up a database in a separate vba database:
Sub test()
Dim accObj As Access.application, Msg As String
Dim application As String, dbs As String, workgroup As String
Dim user As String, password As String, cTries As Integer
Dim x
Dim theDB As Database
' This is the default location of Access
application = "C:\Program Files (x86)\Microsoft Office\OFFICE11\MSACCESS.EXE"
' Use the path and name of a secured MDB on your system
dbs = "C:\ucpdatas\awashic-pc\APLReporting.mdb"
' This is the default working group
workgroup = "E:\Tickets\CSN_NotSure\Secured.mdw"
user = "aleer"
password = "****"
Debug.Print application & " " & Chr(34) & dbs & Chr(34) & " /nostartup /user " & user & " /pwd " & password & " /wrkgrp " & Chr(34) & workgroup & Chr(34), vbMinimizedFocus
x = Shell(application & " " & Chr(34) & dbs & Chr(34) & " /nostartup /user " & user & " /pwd " & password & " /wrkgrp " & Chr(34) & workgroup & Chr(34), vbMinimizedFocus)
On Error GoTo WAITFORACCESS
Set accObj = GetObject(, "Access.Application")
' Turn off error handling
On Error GoTo 0
' You an now use the accObj reference to automate Access
Debug.Print "Access is now open."
' Do Stuff...
accObj.CloseCurrentDatabase
accObj.Quit
' Close it out...
Set accObj = Nothing
Debug.Print "Closed and complete."
Exit Sub
WAITFORACCESS: ' <--- this line must be left-aligned.
' Access isn't registered in the Running Object Table yet, so call
' SetFocus to take focus from Access, wait half a second, and try again.
' If you try five times and fail, then something has probably gone wrong,
' so warn the user and exit.
'SetFocus
If cTries < 5 Then
cTries = cTries + 1
Sleep 500 ' wait 1/2 seconds
Resume
Else
Debug.Print "It didn't work"
End If
End Sub
This line...
x = Shell(application & " " & Chr(34) & dbs & Chr(34) & " /nostartup /user " & user & " /pwd " & password & " /wrkgrp " & Chr(34) & workgroup & Chr(34), vbMinimizedFocus)
Turns out to be...
C:\Program Files (x86)\Microsoft Office\OFFICE11\MSACCESS.EXE "C:\ucpdatas\awashic-pc\APLReporting.mdb" /nostartup /user aleer /pwd *** /wrkgrp "E:\Tickets\CSN_NotSure\Secured.mdw" 2
... at the command line.
But when the database opens it executes a bunch of vba codes and displays error messages.
There is no way for Access to open without running the AutoExec macro associated with that database. The only solution would be to have the AutoExec contain conditional arguments that determined how the database was opened, and not run the commands if the database was shell'd. This would require editing every database to include this logic.
Technically, yes there is a way to open an MS-Access 2003 database from the command line without running any of the startup macros, although it does not involve the command line arguments: If you hold down the Shift key while the database opens, it will not run the AutoExec script (and suppresses a few other things). This also assumes the AllowBypassKey property has not been set to False.
See Ignore startup options

Insert Reboot Command in Microsoft Update Script

I'm a complete novice in scripting, so starting off just trying to tweak other scripts. I found a script that checks, downloads, and installs Microsoft updates from command line. Is there a way to include a reboot command when complete, or perhaps daisy chain or pipe in a command after it?
To run it, you type cscript.exe ForceAU.vbs
Is there a way to add a command (shutdown /r) to/after it, or does it have to be a setting in the script itself?
'************************************
'* Force Automatic Update Script *
'* Goto http://www.intelliadmin.com *
'* for more tools and utilities *
'************************************
' This script was adapted to only
' install non-prompting updates
' and not ask any questions
' Original script can be found here:
' http://msdn.microsoft.com/en-us/library/windows/desktop/aa387102(v=vs.85).aspx
On Error Resume Next
function IsSecurityUpdate(Update)
Set Categories = Update.Categories
sName = lcase(Categories.Item(0).Name)
'This works on all languages...the category name is always in english
if (sName = "security updates" or sName="critical updates") then
IsSecurityUpdate = TRUE
else
IsSecurityUpdate = FALSE
end if
end function
Sub ForceUpdate()
Set updateSession = CreateObject("Microsoft.Update.Session")
Set updateSearcher = updateSession.CreateupdateSearcher()
WScript.Echo "Searching for updates..." & vbCRLF
Set searchResult = updateSearcher.Search("IsInstalled=0 and Type='Software' and IsHidden=0")
WScript.Echo vbCRLF & "Creating collection of updates to download:"
Set updatesToDownload = CreateObject("Microsoft.Update.UpdateColl")
bFound = FALSE
For I = 0 to searchResult.Updates.Count-1
Set update = searchResult.Updates.Item(I)
If IsSecurityUpdate(update) then
WScript.Echo " " & update.Title
updatesToDownload.Add(update)
bFound = TRUE
end if
Next
if (NOT(bFound)) then
WScript.Echo "This computer is up to date"
Exit Sub
end if
WScript.Echo vbCRLF & "Downloading updates..."
Set downloader = updateSession.CreateUpdateDownloader()
downloader.Updates = updatesToDownload
downloader.Download()
WScript.Echo vbCRLF & "List of downloaded updates:"
For I = 0 To searchResult.Updates.Count-1
Set update = searchResult.Updates.Item(I)
If update.IsDownloaded Then
WScript.Echo I + 1 & "> " & update.Title
End If
Next
Set updatesToInstall = CreateObject("Microsoft.Update.UpdateColl")
WScript.Echo vbCRLF & _
"Creating collection of downloaded updates to install:"
For I = 0 To searchResult.Updates.Count-1
set update = searchResult.Updates.Item(I)
If update.IsDownloaded = true Then
if (IsSecurityUpdate(update)) then
WScript.Echo I + 1 & "> adding: " & update.Title
updatesToInstall.Add(update)
end if
End If
ext
WScript.Echo "Installing updates..."
Set installer = updateSession.CreateUpdateInstaller()
installer.Updates = updatesToInstall
Set installationResult = installer.Install()
'Output results of install
WScript.Echo "Installation Result: " & _
installationResult.ResultCode
WScript.Echo "Reboot Required: " & _
installationResult.RebootRequired & vbCRLF
WScript.Echo "Listing of updates installed " & _
"and individual installation results:"
For I = 0 to updatesToInstall.Count - 1
WScript.Echo I + 1 & "> " & _
updatesToInstall.Item(i).Title & _
": " & installationResult.GetUpdateResult(i).ResultCode
Next
end sub
ForceUpdate()
if (Err.Number<>0) then
WScript.Echo "Error Downloading Updates. Check your internet connection"
end if
You can try to execute "shutdown -r -t 5" will reboot after 5 seconds.
Maybe something like this:
Set oShell = WScript.CreateObject("WSCript.shell")
oShell.run "cmd shutdown -r -t 5"