VBScript not working when PC is locked - vbscript

I'm running a VBScript that communicates to an exe file in Windows 7.
The VBScript works great!
The issues I have, is that once the PC has been in locked, goes to sleep or hiberation the VBScript doesn't communicate with the exe application.
The VBScript is running (I have a log that tells me every time a loop is complete, but its not communicating to the exe.
Below is code that is not working when the PC is locked.
Set WSHShell = WScript.CreateObject("WScript.Shell")
' info for exporting data
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Dim fso, MyFile, FileName, TextLine, cycles
Dim I
I = 0
Dim n
n = .1 'how often the program saves the data (in minutes)
cycles = 2 'how many times it will save
FileName = "C:\Users\Desktop\new.txt" 'location where the log file will save
Dim sl
sl = n * 60000 'change from seconds to ms for the sleep function
Set fso = CreateObject("Scripting.FileSystemObject")
' Open the file for output
Set MyFile = fso.OpenTextFile(FileName, ForAppending, True, TristateTrue)
' Write to the file.
MyFile.WriteLine "Log file for recording data from Yokogawa MX100 (" & cycles
& " cycles)"
WSHShell.Run "MXStandardE.exe"
WScript.Sleep 1000
WSHShell.AppActivate "MXStandardE.exe"
WScript.Sleep 1000
Do while I < cycles
a = Now()
WScript.Sleep 1000
WSHShell.Run "MXStandardE.exe"
WScript.Sleep 1000
WSHShell.AppActivate "MXStandardE.exe"
WScript.Sleep 1000
WSHShell.SendKeys "%A"
WScript.Sleep 1000
WSHShell.SendKeys "{DOWN}"
WScript.Sleep 1000
WSHShell.SendKeys "{ENTER}"
I = I + 1
MyFile.Writeline I & " of " & cycles & " at " & a & " --time of each cycle is
" & n & " minutes"
WScript.Sleep sl 'when sl is used loop time is in minutes
Loop
MyFile.Close
MsgBox ("Script has completed")

As Ansgar already said, it's pretty obvious that nothing will work while the PC sleeps or hibernates. In the case where the PC is locked, techniques that rely on window management or direct input such as SendKeys won't work as expected, because the user's session, along with user-level applications, is essentially shelved to make way for the login screen or another user.
You might want to do some research into the SendMessage/PostMessage API, or you can stop using VBScript and replace it with a Scheduled Task or system service that runs using a local service account, assuming you just want to execute an exe without any UI interaction.

The question is: do you need to go under hibernation or pc suspension? If not, you should simply configure or turn off those settings. By only locking the session, the vbscript should be run and generate an outpout without any trouble. By checking and configuring advanced windows energy settings it might help you solving this.

Related

VBScript loops in section of sub that does not contain looping code

Windows 10 Enterprise
Version 20H2
I am writing a VBScript that handles a print to PDF dialogue window.
The goal:
Detect that the printer dialogue window is open (using a loop that continuously checks)
If/when detected, handle the dialogue (send the filename, send the file path, click "print" to finish)
The problem: for some reason, the sub endlessly loops through an If statement. I don't understand why the code is looping through a section containing no loop code.
The code basically sends the same keys in a loop over and over again within the dialogue window, never completing the If statement.
As a small aside, I think the sendKeys command I use to close the dialogue is incorrect, but that should not cause an IF statement to loop.
Code (go to the section indicated by "#"'s to see where I am having issues):
Sub handlePrintDial()
iSeconds = 20
'================================================================================
' Set time variables
'================================================================================
tNow = now()
tFuture = DateAdd("s",iSeconds,tNow)
'================================================================================
' Set other objects
'================================================================================
Set WshShell = CreateObject("WScript.Shell")
sApp = "Save Print Output As"
sFileName = "This is a test-" & Year(now()) & Month(now()) & Day(now()) & Hour(now()) & Minute(now()) & Second(now())
'================================================================================
' Loop until window opens or time elapses
'================================================================================
Do Until Now() > tFuture
ret = WshShell.AppActivate(sApp)
If ret = True Then
Exit Do
End If
Loop
If ret <> True Then
MsgBox "Printer window not found. Please try again."
Exit Sub
End If
'================================================================================
' If printer window detected, handle window
'================================================================================
WScript.Sleep 500
ret = WshShell.AppActivate(sApp)
'########This is the top of the endless loop####################
If ret = True Then
ret = wshShell.AppActivate(sApp)
' Send filename
WScript.Sleep 2000
wshShell.sendKeys sFileName
WScript.Sleep 2000
' Send file path to save to
wshShell.sendKeys "{F4}"
WScript.Sleep 2000
wshShell.sendKeys "{BS}"
WScript.Sleep 2000
wshShell.sendKeys "^A"
WScript.Sleep 2000
wshShell.sendKeys "{del}"
WScript.Sleep 2000
wshShell.sendKeys "C:\Users\Username\Desktop\closeDialogue.vbs"
WScript.Sleep 2000
' "Click" print to complete the dialogue window
wshShell.sendKeys "{enter}"
WScript.Sleep 2000
wshShell.sendKeys "{enter}"
WScript.Sleep 2000
End If
WScript.Sleep 500
'########This is the bottom of the endless loop####################
WScript.Quit
End Sub
Call handlePrintDial()
Here is the window I am trying to handle:
After some experimentation, I discovered that the sendKeys "{enter}" commands were mysteriously causing the script to execute again (two simultaneous instances of the code running at once, per command line). When I removed Enter keys, the code ran normally without kicking off new instances of the script.
Summary: use sendKeys at your own peril. Specifically, it appears {enter} can cause the code to have unusual problems.

Windows shell script not able to make existing IE window visible?

I have been trying to create a really simple script to maintain visibility on an IE page but am currently unable to force the visibility or foreground position of an existing IE window.
I am able to successfully activate the window using WshShell.AppActivate() but it does not make the page foreground to a user. A sample from my code is below.
Basically the code loops until the user ends the notepad window. my confusion is specifically with why IE is not visible no matter what commands I send
Dim pressX
Dim FindProc
pressX = 1
' Create WScript Shell Object to access filesystem.
Set WshShell = WScript.CreateObject("WScript.Shell")
'WshShell.Run "NoScreenSaver.txt", 2, 0
' Define Which process to seek for to terminate script
strComputer = "."
FindProc = "NoScreenSaver"
Dim objApp : Set objApp = CreateObject("Shell.Application")
Dim IE : Set IE = Nothing
Dim objWindow
' Loop start
Do
' Wait for 5 minutes
WScript.Sleep 3000 '000
For Each objWindow In objApp.Windows
If (InStr(objWindow.Name, "Internet Explorer")) Then
Set IE = objWindow
Exit For
End If
Next
' check if specific notepad closed
If WshShell.AppActivate("NoScreenSaver.txt") = True Then
'WshShell.AppActivate("iexplore.exe")
'wscript.echo FindProc & " is running"
Else
wscript.echo FindProc & " is not running" & vbCrLf & "Script will now end"
pressX = 0
End If
IE.visible = True
wshshell.appactivate ie.name
IE.navigate "google.ca"
' Send dummy key
WshShell.SendKeys "{F13}"
' repeat
Loop While pressX
I never wanted to use AppActivate to check for the specific notepad window either since it would take foreground. There is some information regarding using a COM wrapper but the COM wrapper approach is not possible within my constraints.

Zipping a large folder fails

I am trying to archive logs to capture an intermittent fault where my logs are regularly overwritten. I wish to archive the logs to ensure I capture the required event.
I have written what appears to be funcional code to perform this, however if the folder is very large, the zip fails. If I point it to a smaller directory, it works without issue.
There is no error generated, and I would appreciate any assistance in identifying the cause.
As I have never programmed in VBS before, I apologise in advance if this seems a simple question.
Option Explicit
dim objFSO, objFolder, FolderToZip, ziptoFile
dim ShellApp, eFile, oNewZip, strZipHeader
dim ZipName, Folder, i, Zip
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("D:\Program Files\afolder")
Wscript.Sleep 2000
Set oNewZip = objFSO.OpenTextFile("C:\Archive\logs_" & day(date) & month(Date) & Year(date)& ".zip", 8, True)
strZipHeader = "PK" & Chr(5) & Chr(6)
For i = 0 to 17
strZipHeader = strZipHeader & Chr(0)
Next
oNewZip.Write strZipHeader
oNewZip.Close
Set oNewZip = Nothing
WScript.Sleep 5000
FolderToZip = "D:\Program Files\afolder"
ZipToFile = "C:\Archive\logs_" & day(date) & month(Date) & Year(date)& ".zip"
Set ShellApp = CreateObject("Shell.Application")
Set Zip= ShellApp.NameSpace(ZipToFile)
Set Folder= ShellApp.NameSpace(FolderToZip)
Zip.CopyHere(FolderToZip)
WScript.Sleep 2000
Your code is a little more complicated than it needs to be, but it works in principle. What's causing the failures you're experiencing with large folders is the fixed 2 second delay at the end:
WScript.Sleep 2000
CopyHere runs asynchronously, meaning that it runs in the background while the script continues. However, after 2 seconds delay the script terminates (and the Shell.Application instance with it), whether CopyHere has finished or not. When you have numerous/large files the processing may well take more than 2 seconds.
That's why your script works fine for small folders, but not for large ones. The copying simply isn't finished when the script terminates after 2 seconds.
To avoid this, replace the fixed delay with a check that compares the number of processed files to the total file count:
Set fso = CreateObject("Scripting.FileSystemObject")
Set app = CreateObject("Shell.Application")
zipfile = "C:\Temp\logs_" & Day(Date) & Month(Date) & Year(Date) & ".zip"
fldr = "C:\Temp\sample"
cnt = fso.GetFolder(fldr).Files.Count
'create a new empty zip file
fso.OpenTextFile(zipfile, 2, True).Write "PK" & Chr(5) & Chr(6) _
& String(18, Chr(0))
'start copying the files from the source folder to the zip file
Set zip = app.NameSpace(zipfile)
zip.CopyHere app.NameSpace(fldr).Items '<- runs asynchronously!
'wait for CopyHere to finish
Do
WScript.Sleep 100
Loop Until zip.Items.Count = cnt

VB script on Cisco Anyconnect VPN

I am new to use VB script. I am using the below code to connect my VPN. But the problem is that after entering "select" button in VPN client, the second page display is depending on Network Speed. Sometimes it is loaded within 4 sec, sometimes after 10 sec. Is there any code where i can get the VPN is fully loaded or not (like BUSY command for IE).
set WshShell=Wscript.CreateObject("Wscript.Shell")
WshShell.Run("""C:\\Program Files\Cisco\Anyconnect\vpnui.exe""")
WScript.Sleep 500
WshShell.SendKeys "{ENTER}"
WScript.Sleep 500
WshShell.SendKeys "username"
WshShell.SendKeys "rsa_no"
WshShell.SendKeys "password"
WScript.Sleep 500
WshShell.SendKeys "{ENTER}"
Whilst not vb script, I think this approach should still work.
I have the vpncli directory in my %path%
I have a batch file:
vpncli.exe connect xyz.123.com -s < d:\vpncreds.txt
with the credentials in a separate file (d:\vpncreds.txt):
username
password
y
Note: you need an empty line at the end.
This works fine here, and wonder if you take the credentials out of your VB script and put them in a separate file, it might achieve what you need to.
Also, if your credentials change, you only need to change the one file, and not the potential handful of script files if you access the vpn in multiple scripts.
Try my code below. Note that you may have to adjust sleep times (in milliseconds). To see what's happening in the command prompt, change the 2 in the 9th line to a 1.
Dim host, username, password, pathToClient
host = "yourHostURL"
username = "yourUsername"
password = "yourPassword"
pathToClient = "C:\Program Files {(}x86{)}\Cisco\Cisco AnyConnect Secure Mobility Client\vpncli.exe"
Set ws = WScript.CreateObject("WScript.Shell")
ws.run("TASKKILL.exe /F /IM vpnui.exe"), 0, false
ws.run("cmd.exe"), 2, false
ws.AppActivate("Command Prompt")
WScript.Sleep 300
ws.SendKeys """" & pathToClient & """ connect " & host & "~"
WScript.Sleep 1000
ws.SendKeys(username & "~")
WScript.Sleep 50
ws.SendKeys(password & "~")
ws.run("TASKKILL.exe /F /IM cmd.exe"), 0, false
Here is an improved version that doesn't wait for sleep timeouts, i.e. connects as soon as the window becomes visible. This works with the latest version of AnyConnect (4.10 as of writing).
' Script to automatically connect to Cisco AnyConnect.
' This script assumes that you have already set up your connection.
Const Password = "[YOUR PASSWORD]" ' Enter your password here
Const ConnectionUrl = "[YOUR CONNECTION URL]" ' Enter the URL of your endpoint (without HTTP prefix)
' Copy password to clipboard in case something goes wrong (to connect manually)
CopyToClipboard(Password)
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run """%PROGRAMFILES(x86)%\Cisco\Cisco AnyConnect Secure Mobility Client\vpnui.exe"""
ActivateWindow("Cisco AnyConnect Secure Mobility Client")
WshShell.SendKeys "{ENTER}"
ActivateWindow("Cisco AnyConnect | " + ConnectionUrl)
WshShell.SendKeys "{TAB}"
WshShell.SendKeys Password
WshShell.SendKeys "{ENTER}"
Function ActivateWindow(title)
Const Step = 100
Const Timeout = 10000
Dim Result
Dim Counter
For Counter = 0 To Timeout Step Step
Result = WshShell.AppActivate(title)
If Result Then Exit For
WScript.Sleep Step
Next
If Result = False Then
MsgBox("Window '" + title + "' not found.")
WScript.Quit
End If
End Function
Function CopyToClipboard(Input)
If IsNull(Input) Then
Set Clipboard = CreateObject("HTMLFile").parentWindow.clipboardData.getData("Text")
If IsNull(Clipboard) Then Clipboard = ""
Else
CreateObject("WScript.Shell").Run _
"mshta.exe javascript:eval(""document.parentWindow.clipboardData.setData('text','" _
& Replace(Replace(Replace(Input, "'", "\\u0027"), """","\\u0022"),Chr(13),"\\r\\n") & "');window.close()"")", _
0,True
End If
End Function

Set interval in vbscript

I want to set interval time in vbscript
Following is my code
Set objWord = CreateObject("Word.Application")
endTime= Timer()
'Set visibilty for the client application
objWord.Visible = True
WScript.Sleep 1000
'Close MS word process
objWord.Quit
I found WScript.Sleep 1000 or WScript.Sleep(1000) 1000 is in millisecond
but both of them are not working fine, I am using window7
Quick-and-dirty batch command is the safest and surest (though not the most accurate) way to get a delay.
' Get a 10 seconds delay
Delay 10
Sub Delay( seconds )
Dim wshShell
Set wshShell = CreateObject( "WScript.Shell" )
wshShell.Run "ping -n " & ( seconds + 1 ) & " 127.0.0.1", 0, True
Set wshShell = Nothing
End Sub
As seen on Rob van der Woude's Scripting Page .Here you can also find lot of good scripts

Resources