Access VBA to Close a Chrome window opened via Shell - shell

I am attempting to close a shell Chrome window via a VBA function. My function runs a URL query that returns a .csv file. The thing is I would like to close the window so that it is not always showing (This process runs every 3 minutes). I haven't been able to find a solution that I can get to work as of yet. I tried adding SendKeys "%{F4}" after as one site suggested. This merely minimizes the window, not close it. I also attempted to try adding DoCmd.Close Shell, "Untitled" after, yet this also did not work. I have spent several hours attempting to do, what I imagine is a simple task, and felt another set of eyes could point me in the right direction. Below is my code that opens Chrome. Any assistance is greatly appreciated.
Public Function RunYahooAPI()
Dim chromePath As String
chromePath = """C:\Program Files\Google\Chrome\Application\chrome.exe"""
Shell (chromePath & " -url http://download.finance.yahoo.com/d/quotes.csv?s=CVX%2CXOM%2CHP%2CSLB%2CPBA%2CATR%2CECL%2CNVZMY%2CMON&f=nsl1op&e=.csv")
End Function

this VBA code will launch (as in your question) chrome, save the Process handle in the variable pHandle, loop all processes with this Handle and then stop the process (after checking user and domain of the process owner) .
Sub LaunchandStopProcess()
'
' As in your Question
'
Dim chromePath As String
Dim pHandle As Variant
chromePath = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
'
' Note: Shell pass the Process Handle to the PID variable
'
PHandle = Shell(chromePath & " -url http://download.finance.yahoo.com/d/quotes.csv?s=CVX%2CXOM%2CHP%2CSLB%2CPBA%2CATR%2CECL%2CNVZMY%2CMON&f=nsl1op&e=.csv")
Dim objWMIcimv2 As Object
Dim objProcess As Object
Dim objList As Object
Dim ProcToTerminate As String
Dim intError As Integer
Set objWMIcimv2 = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set objList = objWMIcimv2.ExecQuery("select * from win32_process where Handle='" & CStr(pHandle) & "'")
'
' ObjList contains the list of all process matching the Handle (normally your chrome App, if running)
'
If objList.Count = 0 Then
' No matching Process
' Set all objects to nothing
Set objWMIcimv2 = Nothing
Set objList = Nothing
Set objProcess = Nothing
Exit Sub
Else
'
' Parse all matching Processes
'
For Each objProcess In objList
' additionally check with actual user
colProperties = objProcess.getowner(strNameofUser, strUserdomain)
If strUserdomain + "\" + strNameofUser = Environ$("userdomain") + "\" + Environ$("username") Then
intError = objProcess.Terminate
If intError <> 0 Then
'
' Trap Error or do nothing if code run unattended
'
Else
' Confirm that process is killed or nothing if code run unattended
End If
End If
Next
Set objWMIcimv2 = Nothing
Set objList = Nothing
Set objProcess = Nothing
End If
End Sub

Related

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.

Get running instance of application from WMI process?

I'm trying to get hold of running instances of MS Access 2010+ (on Win10) but the usual tip; GetObject(, "Access.Application") ... for works only for hidden instances started by myself with script, but not any instances started from GUI by the user.
And yes, I've read perhaps ten or more google hits on the subject, both on WMI and GetObject, but I seem to have missed something important.
However, I've tried the code below and I can get hold of any process of running Access instances in this way, and I can even .terminate() them, but, that's not what I want to do. Instead I want to grab the process and assign it to a usable (correct type) Access variable (see "OutInstance" in the code below) :
[Edit: Using WHERE clause, and skipped Exit as to retrieve the last instance]
Public Function GetRunningInstance(sAppName sComputer, ByRef OutInstance)
Dim oWMIService
Dim wProcesses
Dim oPrc
GetRunningInstance = False
Set OutInstance = Nothing
if sComputer = "" then sComputer = "."
Set oWMIService = GetObject("winmgmts:" & "{impersonationLevel=" & _
"impersonate}!\\" & sComputer & "\root\cimv2")
Set wProcesses = oWMIService.ExecQuery ("SELECT * FROM Win32_Process " & _
"WHERE Name = '" & sAppName & "'")
For Each oPrc in wProcesses
''' oPrc.Terminate() ''' Works, I can shut down Access...
Set OutInstance = oPrc
GetRunningInstance = True
''' By not exiting we get the last instance.
Next
End Function
Now, after trying to get hold of an instance, how do I "cast" the process to a usable Access application variable in this VBScript?
Sub Test_DoStuff()
Dim InstProc
Dim AccessApp
If GetRunningInstance("msaccess.exe", "127.0.0.1", InstProc) Then
Set AccessApp = ''' cast 'InstProc' to my "Access.Application" somehow?
Else
Set AccessApp = CreateObject("Access.Application")
End If
'''
''' Doing my stuff
'''
AccessApp.CloseCurrentDatabase
AccessApp.DoCmd.Quit
End Sub
Test
I (also) don't understand why GetObject(, "Access.Application") doesn't work in all cases. Permissions? (I understand that it's 'unsafe' to close a database currently being used by a user, but also that can be dealt with).
// Rolf

Run script in background

I want to run following script as scheduled task on Windows 7 in background. Now, script displays cmd window and, can I run script without visible cmd window?
Option Explicit
Dim WshShell, oExec
Dim RegexParse
Dim hasError : hasError = 0
Set WshShell = WScript.CreateObject("WScript.Shell")
Set RegexParse = New RegExp
Set oExec = WshShell.Exec("%comspec% /c echo list volume | diskpart.exe")
RegexParse.Pattern = "\s\s(Volume\s\d)\s+([A-Z])\s+(.*)\s\s(NTFS|FAT)\s+(Mirror|RAID-5)\s+(\d+)\s+(..)\s\s([A-Za-z]*\s?[A-Za-z]*)(\s\s)*.*"
While Not oExec.StdOut.AtEndOfStream
Dim regexMatches
Dim Volume, Drive, Description, Redundancy, RaidStatus
Dim CurrentLine : CurrentLine = oExec.StdOut.ReadLine
Set regexMatches = RegexParse.Execute(CurrentLine)
If (regexMatches.Count > 0) Then
Dim match
Set match = regexMatches(0)
If match.SubMatches.Count >= 8 Then
Volume = match.SubMatches(0)
Drive = match.SubMatches(1)
Description = Trim(match.SubMatches(2))
Redundancy = match.SubMatches(4)
RaidStatus = Trim(match.SubMatches(7))
End If
If RaidStatus <> "Healthy" Then
hasError = 1
'WScript.StdOut.Write "WARNING "
MsgBox "Status of " & Redundancy & " " & Drive & ": (" & Description & ") is """ & RaidStatus & """", 16, "RAID error"
End If
End If
Wend
WScript.Quit(hasError)
Thanks a lot
Option 1 - If the task is running under your user credentials (if not, msgbox will not be visible)
There are two possible sources for the cmd window.
a) The script itself. If the task is executing cscript, the console window will be visible, avoid it calling wscript instead
b) The Shell.exec call. The only way to hide this window is to start the calling script hidden. On start of your script test for the presence of certain argument. If not present, make the script call itself with the argument, using Run method of the WshShell object, and indicating to run the script with hidden window. Second instance of the script will start with the special parameter, so it will run, but this time windows will be hidden.
Option 2 - Running the task under system credentials.
In this case, no window will be visible. All will be running in a separate session. BUT msgbox will not be seen. Change MsgBox call with a call to msg.exe and send a message to current console user.

VBS Runtime error code 800A01B6

I am a newbie to VBS scripting. I am getting above error on line 54, character 5 in script below. This error says "Object doesn't support this property or method: 'MimeMapArray'".
And line it is referring to is:
MimeMapArray(i) = CreateObject("MimeMap")
Can u tell me what I am doing wrong? Here is the script in its entirety. Note, I am trying to run this on an XP OS by double-clicking this VBS file.
' This script adds the necessary Windows Presentation Foundation MIME types
' to an IIS Server.
' To use this script, just double-click or execute it from a command line.
' Running this script multiple times results in multiple entries in the IIS MimeMap.
' Set the MIME types to be added
Dim MimeMapObj
Dim MimeMapArray
Dim WshShell
Dim oExec
Const ADS_PROPERTY_UPDATE = 2
Dim MimeTypesToAddArray
MimeTypesToAddArray = Array(".manifest", "application/manifest", ".xaml", _
"application/xaml+xml", ".application", "application/x-ms-application", _
".deploy", "application/octet-stream", ".xbap", "application/x-ms-xbap", _
".xps", "application/vnd.ms-xpsdocument")
' Get the mimemap object
Set MimeMapObj = GetObject("IIS://LocalHost/MimeMap")
' Call AddMimeType for every pair of extension/MIME type
For counter = 0 to UBound(MimeTypesToAddArray) Step 2
AddMimeType MimeTypesToAddArray(counter), MimeTypesToAddArray(counter+1)
Next
' Create a Shell object
Set WshShell = CreateObject("WScript.Shell")
' Stop and Start the IIS Service
Set oExec = WshShell.Exec("net stop w3svc")
Do While oExec.Status = 0
WScript.Sleep 100
Loop
Set oExec = WshShell.Exec("net start w3svc")
Do While oExec.Status = 0
WScript.Sleep 100
Loop
Set oExec = Nothing
' Report status to user
WScript.Echo "Windows Presentation Foundation MIME types have been registered."
' AddMimeType Sub
Sub AddMimeType(ByVal Ext, ByVal MType)
' Get the mappings from the MimeMap property.
MimeMapArray = MimeMapObj.GetEx("MimeMap")
' Add a new mapping.
i = UBound(MimeMapArray) + 1
ReDim Preserve MimeMapArray(i)
MimeMapArray(i) = CreateObject("MimeMap")
MimeMapArray(i).Extension = Ext
MimeMapArray(i).MimeType = MType
MimeMapObj.PutEx ADS_PROPERTY_UPDATE, "MimeMap", MimeMapArray
MimeMapObj.SetInfo()
End Sub
The first thing I can suggest is use cscript to execute. You can get more information that won't go away like with a message box.
Open a command prompt (go to start,
run, type CMD).
Go to the location where your script
is and type the following:
cscript scriptname.vbs
...where scriptname.vbs is the name of your script.
Second, you appear to be missing the "set" in front of your createobject line. Have a look here for reference.
That line should look like:
set MimeMapArray(i) = CreateObject("MimeMap")

Use clipboard from VBScript

I am looking for a method to place some text onto the clipboard with VBScript. The VBScript in question will be deployed as part of our login script. I would like to avoid using anything that isn't available on a clean Windows XP system.
Edit:
In answer to the questions about what this is for.
We wanted to encourage users inside our organization to use the file server to transfer documents instead of constantly sending attachments by email. One of the biggest barriers to this is that it isn't always obvious to people what the correct network path is to a file/folder. We developed a quick script, and attached it to the Windows context menu so that a user can right click on any file/folder, and get a URL that they can email to someone within our organization.
I want the URL displayed in the dialog box to also be placed onto the clipboard.
GetNetworkPath
Another solution I have found that isn't perfect in my opinion, but doesn't have the annoying security warnings is to use clip.exe from a w2k3 server.
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "cmd.exe /c echo hello world | clip", 0, TRUE
Example with a multiline string as per question below :
Link1
Dim string
String = "text here" &chr(13)& "more text here"
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "cmd.exe /c echo " & String & " | clip", 0, TRUE
Using Microsoft's clip.exe is the closest to having a clean Windows XP system solution. However you don't have to call CMD.EXE to host it in order to use it. You can call it directly and write to its input stream in your script code. Once you close the input stream clip.exe will write the contents straight to the clipboard.
Set WshShell = CreateObject("WScript.Shell")
Set oExec = WshShell.Exec("clip")
Set oIn = oExec.stdIn
oIn.WriteLine "Something One"
oIn.WriteLine "Something Two"
oIn.WriteLine "Something Three"
oIn.Close
If you need to wait for clip to be finished before your script can continue processing then add
' loop until we're finished working.
Do While oExec.Status = 0
WScript.Sleep 100
Loop
And don't forget to release your objects
Set oIn = Nothing
Set oExec = Nothing
The closest solution I have found so far is a method to use IE to get and set stuff on the clipboard. The problem with this solution is the user gets security warnings. I am tempted to move 'about:blank' to the local computer security zone so I don't get the warnings, but I am not sure what the security implications of that would be.
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate("about:blank")
objIE.document.parentwindow.clipboardData.SetData "text", "Hello This Is A Test"
objIE.Quit
http://www.microsoft.com/technet/scriptcenter/resources/qanda/dec04/hey1215.mspx
No security warnings, full let and get access:
'create a clipboard thing
Dim ClipBoard
Set Clipboard = New cClipBoard
ClipBoard.Clear
ClipBoard.Data = "Test"
Class cClipBoard
Private objHTML
Private Sub Class_Initialize
Set objHTML = CreateObject("htmlfile")
End Sub
Public Sub Clear()
objHTML.ParentWindow.ClipboardData.ClearData()
End Sub
Public Property Let Data(Value)
objHTML.ParentWindow.ClipboardData.SetData "Text" , Value
End Property
Public Property Get Data()
Data = objHTML.ParentWindow.ClipboardData.GetData("Text")
End Property
Private Sub Class_Terminate
Set objHTML = Nothing
End Sub
End Class
Example Usage.
' Create scripting object
Dim WShell, lRunUninstall
Set WShell = CreateObject("WScript.Shell")
WShell.sendkeys "^c"
WScript.Sleep 250
bWindowFound = WShell.AppActivate("Microsoft Excel")
WShell.sendkeys ClipBoard.Data
To avoid the security warnings associated with Internet Explorer and clipboard access, I would recommend you use the Word application object and its methods to put your data onto the clipboard. Of course you can only use this on a machine that has MS Word installed, but these days that's most of them. (*In spite of the fact that you asked for stuff on a 'clean' system :) *)
' Set what you want to put in the clipboard '
strMessage = "Imagine that, it works!"
' Declare an object for the word application '
Set objWord = CreateObject("Word.Application")
' Using the object '
With objWord
.Visible = False ' Don't show word '
.Documents.Add ' Create a document '
.Selection.TypeText strMessage ' Put text into it '
.Selection.WholeStory ' Select everything in the doc '
.Selection.Copy ' Copy contents to clipboard '
.Quit False ' Close Word, don't save '
End With
You can find detail on the MS Word application object and its methods here: http://msdn.microsoft.com/en-us/library/aa221371(office.11).aspx
Microsoft doesn't give a way for VBScript to directly access the clipboard. If you do a search for 'clipboard'on this site you'll see:
Although Visual Basic for Applications supports the Screen, Printer, App, Debug, Err, and Clipboard objects, VBScript supports only the Err object. Therefore, VBScript does not allow you to access such useful objects as the mouse pointer or the clipboard. You can, however, use the Err object to provide runtime error handling for your applications.
So using notepad indirectly is probably about the best you'll be able to do with just VBScript.
Here's another version of using the "clip" command, which avoids adding a carriage return, line feed to the end of the string:
strA= "some character string"
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "cmd /C echo . | set /p x=" & strA & "| c:\clip.exe", 2
s = "String: """ & strA & """ is on the clipboard."
Wscript.Echo s
I've only tested this in XP. clip.exe was downloaded from Link and placed in C:\.
I've found a way to copy multi line information to clipboard by vbscript/cmd.
Sequence:
with VBS generate the final "formatted string" that you need copy to clipboard
generate a (txt) file with the "formatted string"
use type command from cmd to paste information to clip by pipe
Example script:
Function CopyToClipboard( sInputString )
Dim oShell: Set oShell = CreateObject("WScript.Shell")
Dim sTempFolder: sTempFolder = oShell.ExpandEnvironmentStrings("%TEMP%")
Dim sFullFilePath: sFullFilePath = sTempFolder & "\" & "temp_file.txt"
Const iForWriting = 2, bCreateFile = True
Dim oFSO: Set oFSO = CreateObject("Scripting.FileSystemObject")
With oFSO.OpenTextFile(sFullFilePath, iForWriting, bCreateFile)
.Write sInputString
.Close
End With
Const iHideWindow = 0, bWaitOnReturnTrue = True
Dim sCommand: sCommand = "CMD /C TYPE " & sFullFilePath & "|CLIP"
oShell.Run sCommand, iHideWindow, bWaitOnReturnTrue
Set oShell = Nothing
Set oFSO = Nothing
End Function
Sub Main
Call CopyToClipboard( "Text1" & vbNewLine & "Text2" )
End Sub
Call Main
The easiest way is to use built-in mshta.exe functionality:
sText = "Text Content"
CreateObject("WScript.Shell").Run "mshta.exe ""javascript:clipboardData.setData('text','" & Replace(Replace(sText, "\", "\\"), "'", "\'") & "');close();""", 0, True
To put to clipboard a string containing double quote char ", use the below code:
sText = "Text Content and double quote "" char"
CreateObject("WScript.Shell").Run "mshta.exe ""javascript:clipboardData.setData('text','" & Replace(Replace(Replace(sText, "\", "\\"), """", """"""), "'", "\'") & "'.replace('""""',String.fromCharCode(34)));close();""", 0, True
Take a look at this post. It describes a hacky approach to read from the clipboard, but I imagine it could be adapted to also write to the clipboard as well, such as changing the Ctrl+V to Ctrl+A then Ctrl+C.
I devised another way to use IE and yet avoid security warnings...
By the way.. this function is in JavaScript.. but u can easily convert it to VBScript..
function CopyText(sTxt) {
var oIe = WScript.CreateObject('InternetExplorer.Application');
oIe.silent = true;
oIe.Navigate('about:blank');
while(oIe.ReadyState!=4) WScript.Sleep(20);
while(oIe.document.readyState!='complete') WSript.Sleep(20);
oIe.document.body.innerHTML = "<textarea id=txtArea wrap=off></textarea>";
var oTb = oIe.document.getElementById('txtArea');
oTb.value = sTxt;
oTb.select();
oTb = null;
oIe.ExecWB(12,0);
oIe.Quit();
oIe = null;
}
Here is Srikanth's method translated into vbs
function SetClipBoard(sTxt)
Set oIe = WScript.CreateObject("InternetExplorer.Application")
oIe.silent = true
oIe.Navigate("about:blank")
do while oIe.ReadyState <> 4
WScript.Sleep 20
loop
do while oIe.document.readyState <> "complete"
WScript.Sleep 20
loop
oIe.document.body.innerHTML = "<textarea id=txtArea wrap=off></textarea>"
set oTb = oIe.document.getElementById("txtArea")
oTb.value = sTxt
oTb.select
set oTb = nothing
oIe.ExecWB 12,0
oIe.Quit
Set oIe = nothing
End function
function GetClipBoard()
set oIe = WScript.CreateObject("InternetExplorer.Application")
oIe.silent = true
oIe.Navigate("about:blank")
do while oIe.ReadyState <> 4
WScript.Sleep 20
loop
do while oIe.document.readyState <> "complete"
WScript.Sleep 20
loop
oIe.document.body.innerHTML = "<textarea id=txtArea wrap=off></textarea>"
set oTb = oIe.document.getElementById("txtArea")
oTb.focus
oIe.ExecWB 13,0
GetClipBoard = oTb.value
oTb.select
set oTb = nothing
oIe.Quit
Set oIe = nothing
End function
In your Class ClipBoard, neither the Clear sub nor the Let Data sub work. I mean they have no effect on Windows Clipboard. Actually, and ironically so, the only sub that works is the one you have not included in your example, that is Get Data! (I have tested this code quite a few times.)
However, it's not your fault. I have tried to copy data to clipboard with ClipboardData.SetData and it's impossible. At least not by creating an "htmlfile" object. Maybe it works by creating an instance of "InternetExplorer.Application" as I have seen in a few cases, but I have not tried it. I hate creating application instances for such simple tasks!
Alkis
If it's just text can't you simply create a text file and read in the contents when you need it?
Another alternative and clearly a kludge, would be to use the SendKeys() method.
No security warnings and no carriage return at the end of line
' value to put in Clipboard
mavaleur = "YEAH"
' current Dir
path = WScript.ScriptFullName
GetPath = Left(path, InStrRev(path, "\"))
' Put the value in a file
Set objFSO=CreateObject("Scripting.FileSystemObject")
outFile=GetPath & "fichier.valeur"
Set objFile = objFSO.CreateTextFile(outFile,True)
objFile.Write mavaleur
objFile.Close
' Put the file in the Clipboard
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "cmd.exe /c clip < " & outFile, 0, TRUE
' Erase the file
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile outFile

Resources