I would like to minimize the execution of the shell window and the execution of the python script with the code below:
Sub RunPython()
Dim oShell, oExec as Object
Dim sriptPath, scriptName, datas, oCmd as String
Dim weekNumber as Integer
Set oShell = CreateObject("WScript.Shell")
oCmd = "python.exe " & scriptPath & scriptName & " " & datas & " " & Str(weekNumber)
Set oExec = oShell.Exec(oCmd)
'We are waiting for the Shell script to be executed'
While oExec.Status = 0
Wend
MsgBox "Hagrid notebook update completed"
End Sub
It is imperative to keep the status information of the oExec object. I tried to insert the notion vbMinimizedFocus, but it doesn't work. Do you have an idea to solve this difficulty?
According to my tests, both of these versions make .Status available.
Option 1. Using pythonw.exe instead of python.exe - it does not minimize the window, but runs it completely in the background.
Option 2. You could add 2 lines at the beginning of the python script:
import ctypes
ctypes.windll.user32.ShowWindow( ctypes.windll.kernel32.GetConsoleWindow(), 6 )
Related
I have written a VB Script code to simulate key press using do loop. This program simulate keystroke event from the keyboard after designated time interval. I need to add a message box to the script so that I can turn it off whenever my work is over. Currently it runs for infinite time in the background until you logoff your system.
This loop should be running in the background until someone manually end it by using the Yes/NO button from the MsgBox or Please suggest any other way to close this script.
Here is the code, I have written:
Set Wshell=CreateObject("Wscript.shell")
Do
Wshell.SendKeys "{SCROLLLOCK}"
WScript.sleep 10000
Loop
I also tried using select statement but it doesn't seem to work.
It enables you to exit before the next button press is issued.
To End the Script on Demand and let the other script run in background you need another solution, at most a different program which gives you a little interface where you can stop it. Or a second script which specifically ends your first one.
Set Wshell=CreateObject("Wscript.shell")
Do
Wshell.SendKeys "{SCROLLLOCK}"
continue = MsgBox ("Do you want to press the ScrollLock again?", vbYesNo, "Question")
Select Case continue
Case vbNo
Exit Do
End Select
WScript.sleep 10000
Loop
Taken from this post: How to stop a vb script running in windows
Option Explicit
Dim WshShell
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "taskkill /f /im Cscript.exe", , True
WshShell.Run "taskkill /f /im wscript.exe", , True
There's a second script to kill of your script the hard way. I don't know how would you imagine to stop the script? If there is no GUI you can't do it on the time you wish. To combine the solutions you could do something like this:
continue = MsgBox ("Do you want to press the ScrollLock again?", vbYesNo, "Question")
Select Case continue
Case vbNo
Dim WshShell
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "taskkill /f /im Cscript.exe", , True
WshShell.Run "taskkill /f /im wscript.exe", , True
End Select
And pull this popping up MsgBox in the corner of the screen, so If you dont want it anymore just press No and you're good. ^^
You can try something like that to ask a question for stopping the script :
Option Explicit
Dim Title,Ws
Title = "Ask a question to stop the script !"
Set Ws=CreateObject("Wscript.shell")
Do
Ws.SendKeys "{SCROLLLOCK}"
WScript.sleep 10000
Call Ask_Question()
Loop
Sub Ask_Question()
Dim Answer
Answer=MsgBox("Did you want to stop this script ?"_
& vbcr & "( Yes / No ) ?",vbQuestion+vbYesNo,Title)
If Answer=vbYes Then
Wscript.Quit(0)
Else
Exit Sub
End If
End Sub
Edit on 19/08/2016 # 12:53
Just a general example :
Since, i don't know what program did you monitor, so i have plan with Notepad.exe as example
This script can check if the program Notepad.exe is running or not
If not so,it, ask you to stop the script or not !
Option Explicit
Dim ProcessPath,WshShell
ProcessPath = "%Windir%\System32\Notepad.exe"
Set WshShell = CreateObject("WScript.Shell")
If AppPrevInstance() Then
MsgBox "There is an existing proceeding !" & VbCrLF &_
CommandLineLike(WScript.ScriptName),VbExclamation,"There is an existing proceeding !"
WScript.Quit
Else
Do
Call Main()
Pause(10) ' Pause 10 seconds
If CheckProcess(DblQuote(ProcessPath)) = False Then
Call Ask_Question()
End If
Loop
End If
'**************************************************************************
Function CheckProcess(ProcessPath)
Dim strComputer,objWMIService,colProcesses,Tab,ProcessName
strComputer = "."
Tab = Split(ProcessPath,"\")
ProcessName = Tab(UBound(Tab))
ProcessName = Replace(ProcessName,Chr(34),"")
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcesses = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = '"& ProcessName & "'")
If colProcesses.Count = 0 Then
CheckProcess = False
Else
CheckProcess = True
End if
End Function
'**************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**************************************************************************
Sub Pause(Secs)
Wscript.Sleep(Secs * 1000)
End Sub
'**************************************************************************
Function AppPrevInstance()
With GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
With .ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE " & CommandLineLike(WScript.ScriptFullName) & _
" AND CommandLine LIKE '%WScript%' OR CommandLine LIKE '%cscript%'")
AppPrevInstance = (.Count > 1)
End With
End With
End Function
'***************************************************************************
Function CommandLineLike(ProcessPath)
ProcessPath = Replace(ProcessPath, "\", "\\")
CommandLineLike = "'%" & ProcessPath & "%'"
End Function
'****************************************************************************
Sub Main()
WshShell.SendKeys "{SCROLLLOCK}"
End Sub
'****************************************************************************
Sub Ask_Question()
Dim Answer,Title
Title = "Ask a question to stop the script !"
Answer=MsgBox("Did you want to stop this script ?"_
& vbcr & "( Yes / No ) ?",vbQuestion+vbYesNo,Title)
If Answer=vbYes Then
Wscript.Quit(0)
Else
Exit Sub
End If
End Sub
'****************************************************************************
I use the following function in a lot of my VBA projects. I initially added the reference to Windows Script Host Object model to take advantage of Intellisense, but then switched to late binding so I didn't have to reference a bunch of stuff.
Private Function RunCMD(ByVal strCMD As String) As String
'Runs the provided command
Dim oShell As Object 'New WshShell
Dim cmd As Object 'WshExec
Dim x As Integer
Const WshRunning = 0
On Error GoTo wshError
x = 0
RunCMD = "Error"
Set oShell = CreateObject("Wscript.Shell")
Set cmd = oShell.Exec(strCMD)
'Debug.Print strCMD
'Stop
Do While cmd.Status = WshRunning
Sleep 100 'for 1/10th of a second
x = x + 1
If x > 1200 Then 'We've waited 2 minutes so kill it
cmd.Terminate
MsgBox "Error: Timed Out", vbCritical, "Timed Out"
End If
Loop
RunCMD = cmd.StdOut.ReadAll & cmd.StdErr.ReadAll
Set oShell = Nothing
Set cmd = Nothing
Exit Function
wshError:
On Error Resume Next
RunCMD = cmd.StdErr.ReadAll
Resume Next
End Function
It works great when you do something like
RunCMD("ping www.bing.com") or
RunCMD("winrs -r:" & strHost & " reg query hklm\system\currentcontrolset\services\cdrom /v start")
However RunCMD("Dir c:\config* /a:-d /b /d /s") fails, and cmd.StdErr.ReadAll gives an Object Variable or With Block not set error. Even a simple RunCMD("Dir") fails.
Why does DIR make the WScript shell crap out? More importantly, how can I use CMD's DIR function (not VBA's DIR function!) to get a list of files that match a search pattern?
Does it work if you preface your dir command with "cmd /c " and wrap your DOS command in double quotes, like
RunCmd("cmd /c ""DIR""")
or
RunCmd("cmd /c ""Dir c:\config* /a:-d /b /d /s""")
I am trying to ping a server before uploading a file with ftp. Recently, a client complained that the process was freezing. I tested the ping process with a vbscript file just to make sure something wasn't broken on the computer. The vbscript worked just fine. So I ran the script from the Access database and it hung just the same as it did before. Is there something about the ping exe that I am missing here?
Vbscript that runs just fine when you double click it.
Const fsoForWriting = 2
Dim oShell, ping, strPath, strPing
Set oShell = WScript.CreateObject ("WScript.Shell")
Set ping = oShell.exec("ping -n 2 -w 750 google.com")
Do While ping.Status = 0
WScript.Sleep 100
Loop
strPing = ping.StdOut.ReadAll
strPath = Wscript.ScriptFullName
Set objFSO = CreateObject("Scripting.FileSystemObject")
strTextFile = objFSO.GetParentFolderName(strPath) & "\PingResults.txt"
Set objTextStream = objFSO.OpenTextFile(strTextFile, fsoForWriting, True)
objTextStream.WriteLine strPing
objTextStream.Close
Set objTextStream = Nothing
Set objFSO = Nothing
Set oShell = Nothing
VBA function that runs on the test database on startup. This is the code that hangs.
Function fFtpOnline(ByVal ComputerName As String)
On Error GoTo ErrHandler
Dim oShell, ping
Set oShell = CreateObject("WScript.Shell")
Set ping = oShell.exec("cscript " & Access.CurrentProject.Path & "\" & "Test.vbs")
Do While ping.Status = 0
DoEvents
Loop
Set oShell = Nothing
Exit Function
ErrHandler:
MsgBox Err.Description & " " & "fFtpOnline "
Resume Next
End Function
This code works fine on my computer but on the client's computer, the code hangs.
This may sound like a rude answer, but by no means is it intended to be. Just as the comment above stated, this is more than likely it issue on your customer's end. If the program works currently on your end and not theirs they have the issue, not the code. I've run into plenty of customers who are clueless so unless they are willing to let you take control of their machine remotely I would recommend them capturing some information for you. ipconfig is a good place to start. And while they are at the command prompt have them try to ping some places. I know this is not a true answer, but it is what I have encountered in the past.
I'm a new VB Script programmer trying to use VB Script to open a pdf file via the default program (Adobe Reader X in this case) and save it as a text file.
The current script I have opens the PDF, waits 1 second, then saves it as text. However, for slower computers, it might take more than 1 second for the PDF to load up. Does anyone know how to do a sleep loop until the file is opened or the status is ready?
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run """C:\Temp\Gasprices.pdf"""
Set objShell = CreateObject("WScript.Shell")
wscript.sleep 1000
objShell.SendKeys "%FAX%S"
First off, since you are a beginner, always use Option Explicit. Many errors are caused by typos in variable names, you will catch them if you force yourself to declare all variables you use.
Secondly, you don't need to create two WScript.Shell objects, just re-use the existing one.
Thirdly, you need to activate the application you want to send commands to. That's what the Shell object's AppActivate method is for. It returns True or False, indicating whether bringing the application in question to the foreground has worked or not. You could use that in a loop (While Not Shell.AppActivate("Adobe Reader") ...) to wait exactly as long as the application needs.
However, the downside is that you need to know the exact title of the application window (or its process ID) for this to work at all. Application titles might change without warning, so this is kind of shaky. The PID is robust but it is not guessable.
In the end you will need the help of WMI to list all processes, fetch the correct PID and then pass that to AppActivate. The Win32_Process class is made for this.
Dim Shell, WMI, pid
Set Shell = WScript.CreateObject("WScript.Shell")
Set WMI = GetObject("winmgmts:!\\.\root\cimv2")
Shell.Run "start ""C:\Temp\Gasprices.pdf"""
pid = WaitForProcess("AcroRd32.exe", 5)
If pid > 0 Then
Shell.AppActivate pid
Shell.SendKeys "%FAX%S"
Else
WScript.Echo "Could not talk to PDF reader"
WScript.Quit 1
End If
Function WaitForProcess(imageName, tries)
Dim wql, process
wql = "SELECT ProcessId FROM Win32_Process WHERE Name = '" & imageName & "'"
WaitForProcess = 0
While tries > 0 And WaitForProcess = 0
For Each process In WMI.ExecQuery(wql)
WaitForProcess = process.ProcessId
Next
If WaitForProcess = 0 Then
WScript.Sleep 1000
tries = tries - 1
End If
Wend
End Function
Note that assigning to the function name (as in WaitForProcess = 0) sets the return value.
You could optimize this by finding the script's own PID and querying
"SELECT ProcessId FROM Win32_Process WHERE ParentProcessId = '" & scriptPID & "'"
in WaitForProcess().
Another possible option would be to test for Process CPU Usage...
You would need to test and see if this works in your environment...
Dim oShell, oExec, PID, X, Z
Set oShell = CreateObject("WScript.Shell")
Set oExec = oShell.Exec(Chr(34) & "C:\ADOBE PATH" & Chr(34) & " " & Chr(34) & "C:\YOUR PDF PATH.pdf" & Chr(34))
PID = oExec.ProcessID
WScript.Echo PID
'Prevent an Endless Loop
Z = 600 'about one minute worse case
Do
WScript.Sleep 100
X = GetCPUUsage(PID)
WScript.Echo X
Z = Z - 1
If oExec.Status <> 0 Then
MsgBox "The Process has been Terminated. Ending Script"
WScript.Quit
End If
Loop Until X = 0 Or Z = 0
If Z > 0 Then
WScript.Echo "Process Is More Or Less Opened"
Else
WScript.Echo "Process is open... Maybe?"
End If
Function GetCPUUsage(ProcID)
Dim objWMIService, colItems, objItem
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
'Just in case
GetCPUUsage = 0
Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT PercentProcessorTime FROM Win32_PerfFormattedData_PerfProc_Process WHERE IDProcess = '" & ProcID & "'", _
"WQL", wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
GetCPUUsage = objItem.PercentProcessorTime
Next
End Function
I have a problem in a VBScript that I am using with a VBA/Excel macro and a HTA. The problem is just the VBScript, I have the other two components, i.e. the VBA macro and HTA front-end working perfectly. But before I explain the problem, I think for you to help me I must help you understand the context of the VBScript.
So, basically all components (VBScript, VBA macro and HTA) are parts of a tool that I am building to automate some manual chores. It pretty much goes like this:
A - HTA
~~~~~~~~~~~~
User selects some files from the HTA/GUI.
Within the HTML of the HTA there is some VBScript within the "SCRIPT" tags which passes the users 4 input files as arguments to a VBScript (executed by WScript.exe - you may refer to note #1 for clarity here)
The script, lets call it myScript.vbs from now on then handles the 4 arguments, 3 of which are specific files and the 4th is a path/folder location that has multiple files in it - (also see note #2 for clarity)
B - myScript.vbs
~~~~~~~~~~~~
myScript.vbs opens up the first 3 arguments which are Excel files. One of them is a *.xlsm file that has my VBA macro.
myScript.vbs then uses the 4th argument which is a PATH to a folder that contains multiple files and assigns that to a variable for passing to a FileSystemObject object when calling GetFolder, i.e.
... 'Other code here, irrelevant for this post
Dim FSO, FLD, strFolder
... 'Other code here, irrelevant for this post
arg4 = args.Item(3)
strFolder = arg4
Set FSO = CreateObject("Scripting.FileSystemObject"
'Get a reference to the folder you want to search
Set FLD = FSO.GetFolder(strFolder)
...
From here I create a loop so that I can sequentially open the files within the folder
and then run my macro, i.e.
...
Dim strWB4, strMyMacro
strMyMacro = "Sheet1.my_macro_name"
'loop through the folder and get the file names
For Each Fil In FLD.Files
Set x4WB = x1.Workbooks.Open(Fil)
x4WB.Application.Visible = True
x1.Run strMyMacro
x4WB.close
Next
...
Please note that when the first 3 Excel files have opened (controlled by code prior to the loop, and not shown here as I am having no problem with that part) I must keep them open.
It is the files in the folder (that was passed as the 4th argument) which must sequentially open and close. But inbetween opening and closing, I require the VBA/macro (wrote in one of the 3 Excel files previously opened) to run each time the loop iterates and opens a new file from the folder (I hope you follow - if not please let me know :) ).
The problem I am having is that the files in the folder open and close, open and close, n number of times (n = # of files in folder, naturally) without waiting for the macro to run. This is not what I want. I have tried the WScript.sleep statement with a 10 second delay after the 'x1.Run strMyMacro' statement, but to no avail.
Any ideas?
Thanks,
QF.
NOTES:
1 - For simplicity/clarity this is how:
strCMD = cmd /c C:\windows\system32\wscript.exe myScript.vbs <arg1> <arg2> <arg3> <arg4>
'FYI - This is run by creating a WShell object, wsObj, and using the .run method, i.e. WShell.run(strCMD)
2 The HTA employs a piece of JavaScript that strips the users 4th input file (HTML: INPUT TYPE="file") and passes that to the the VBScript within the HTA. This gets me round the problem of not being able to exclusively select a FOLDER in HTML.
You need to tell the run to wait until the process is finished. Something like:
const DontWaitUntilFinished = false, ShowWindow = 1, DontShowWindow = 0, WaitUntilFinished = true
set oShell = WScript.CreateObject("WScript.Shell")
command = "cmd /c C:\windows\system32\wscript.exe <path>\myScript.vbs " & args
oShell.Run command, DontShowWindow, WaitUntilFinished
In the script itself, start Excel like so. While debugging start visible:
File = "c:\test\myfile.xls"
oShell.run """C:\Program Files\Microsoft Office\Office14\EXCEL.EXE"" " & File, 1, true
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2:Win32_Process")
objWMIService.Create "notepad.exe", null, null, intProcessID
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colMonitoredProcesses = objWMIService.ExecNotificationQuery _
("Select * From __InstanceDeletionEvent Within 1 Where TargetInstance ISA 'Win32_Process'")
Do Until i = 1
Set objLatestProcess = colMonitoredProcesses.NextEvent
If objLatestProcess.TargetInstance.ProcessID = intProcessID Then
i = 1
End If
Loop
Wscript.Echo "Notepad has been terminated."
This may not specifically answer your long 3 part question but this thread is old and I found this while searching today. Here is one shorter way to: "Wait until a process has finished." If you know the name of the process such as "EXCEL.EXE"
strProcess = "EXCEL.EXE"
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colProcesses = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = '"& strProcess &"'")
Do While colProcesses.Count > 0
Set colProcesses = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = '"& strProcess &"'")
Wscript.Sleep(1000) 'Sleep 1 second
'msgbox colProcesses.count 'optional to show the loop works
Loop
Credit to: http://crimsonshift.com/scripting-check-if-process-or-program-is-running-and-start-it/
Probably something like this? (UNTESTED)
Sub Sample()
Dim strWB4, strMyMacro
strMyMacro = "Sheet1.my_macro_name"
'
'~~> Rest of Code
'
'loop through the folder and get the file names
For Each Fil In FLD.Files
Set x4WB = x1.Workbooks.Open(Fil)
x4WB.Application.Visible = True
x1.Run strMyMacro
x4WB.Close
Do Until IsWorkBookOpen(Fil) = False
DoEvents
Loop
Next
'
'~~> Rest of Code
'
End Sub
'~~> Function to check if the file is open
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function