Call PowerShell from VBScript with parameters - vba

I have a very basic HTA form with a checkbox and a button. I am trying to pass the checkbox status using VBScript in my HTA to a PowerShell script, which is called when the button is clicked. Unfortunately, I am unable to pass the value of the parameter through. It keeps coming across as empty.
Code in HTA:
<html>
<head>
<title>Test Form</title>
<meta content="text/html; charset=utf-8" http-equiv="Content-Type" />
<hta:application applicationname="Proof of concept version="1.0" />
<script language="vbscript">
Sub Resize()
window.resizeTo 500,450
End Sub
Sub ExecutePowerShell()
Dim oShell, scriptPath, appCmd, retVal, retData, isTestCheckBoxChecked
'Collect value from input form
isTestCheckBoxChecked = document.getElementByID("input_checkBoxTest").checked
MsgBox isTestCheckBoxChecked
Set oShell = CreateObject("Wscript.Shell")
Set scriptPath = ".\TestPowershell.ps1 -isTestCheckBoxChecked " & isTestCheckBoxChecked
appCmd = "powershell.exe " & scriptPath
retVal = oShell.Run(appCmd, 1, true)
retData = document.parentwindow.clipboardData.GetData("text")
End Sub
</script>
</head>
<body onload="Resize()">
<h1>Test Form:</h1>
<div style="margin-top:10px; margin-bottom:30px;">
The scipt does the following checks:
<ul>
<li><input name="input_checkBoxTest" type="checkbox" checked="checked"/> This is a test textbox</li>
</ul>
</div>
<br /><br />
<input type="button" id="btn_execute" value="Execute" onclick="ExecutePowerShell()" />
<br /><br />
</body>
</html>
Powershell script:
#Param([Parameter(Mandatory=$true)][bool]$isTestCheckBoxChecked)
Write-host "The value is '$isTestCheckBoxChecked'"
The output I get is:
"The value is ''"
Any guidance will be appreciated.

Three things:
Don't use Set on the following statement. It's just a string, not an object, so using Set here should throw an error.
' Incorrect
Set scriptPath = ".\TestPowershell.ps1 -isTestCheckBoxChecked " & isTestCheckBoxChecked
' Correct
scriptPath = ".\TestPowershell.ps1 -isTestCheckBoxChecked " & isTestCheckBoxChecked
Your Param statement in PowerShell is commented out (#Param). Maybe this is just a typo when posting your question.
After you uncomment your Param statement, you'll get an error about converting from a string to a bool. PowerShell accepts booleans in the format $false/$true or 0/1 for False/True values, respectively. So, you have two options:
' Prefix the boolean with a '$'
scriptPath = ".\TestPowershell.ps1 -isTestCheckBoxChecked $" & isTestCheckBoxChecked
' Or, convert the boolean to a 0/1 (False/True)
scriptPath = ".\TestPowershell.ps1 -isTestCheckBoxChecked " & Abs(isTestCheckBoxChecked)

Related

What should I do to avoid error message "Object variable or With Block Variable not set"

I am new in VBA script and have created small script to get the data from website however I always get error message "Object variable or With Block Variable not set" . please help me to get the best script to display the price "Rp 16.425"
Below are the sample of both HTML and my script :
HTML as screen below :
<div class="S4G9wXKj">
<h3 data-testid="hSRPProdName" class="Ka_fasQS">Buku MATEMATIKA BILINGUAL Kelas X SMA/MA - Yrama Widya</h3>
<div itemprop="offers" itemtype="http://schema.org/Offer">
<span itemprop="price" class="_3fNeVBgQ">
<span data-testid="hSRPProdPrice">Rp 16.425</span>
</span>
<meta itemprop="priceCurrency" content="IDR">
<div class="ifULVzgL"><div class="_3z5GLerJ">
<span class="UY2SWg6T" data-testid="spnSRPProdTabShopLoc">Yogyakarta</span>
<span class="_1GDgKs4K">Yrama Widya Books</span></div></div>
<div class="_3dCNp1CF"></div></div></div>
and this is my script :
Dim XMLPage As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim BHTMLDoc As New MSHTML.HTMLDocument
XMLPage.Open "GET", "https://www.tokopedia.com/search?st=product&q=buku&ob=3&pmin=16411&origin_filter=sort_price", False
XMLPage.send
BHTMLDoc.body.innerHTML = XMLPage.responseText
Dim i As Long
For i = 0 To 3
Debug.Print HTMLDoc.querySelectorAll("[data-testid=hsRPProdPrice] span").Item(i).innerText
Next

VbScript hta - Open a new hta by link and retrieve correct filename

I have two files; "1.hta" and "2.hta".
"1.hta" contains a simple link to file "2.hta"
2.hta
"2.hta" contains a script to determine its own filename
FullName = replace(oApp.commandLine,chr(34),"") 'oApp = HT Application ID
arrFN=split(FullName,"\")
FileName = arrFN(ubound(arrFN))
SourceDir=replace(FullName,FileName,"")
"2.hta" works perfectly when started "stand-alone" --> FileName = 2.hta
However, starting "2.hta" via link from "1.hta" I get --> FileName = 1.hta
I need a way to determine the correct filename, or does hta always retrieve the filename of the first/starting instance?
You can try like this :
<html>
<head>
<title>HTA Launch another HTA</title>
<HTA:APPLICATION
SINGLEINSTANCE="yes"
WINDOWSTATE="maximize"
>
</head>
<SCRIPT Language="vbscript">
Sub Execute(File)
Dim ws
Set ws = CreateObject("wscript.shell")
ws.run chr(34) & File & chr(34)
End sub
</SCRIPT>
<body>
<h1>This is test hta 1 ONE</h1>
Start the HTA2
</body>
</html>

Update search filter with checkbox, VBScript asp

I have this dynamically search script made in a HTA showing all my notes.
I want to add a dynamic filter, based on two checkboxes that filters my SQL string in types: A, U and both (A or U).
When the script loads it runs perfectly and shows all notes with both types (A or U). But when I click the checkboxes I get an error saying: "Object doesn't support property or method" (translated from my language).
The script is fairly simple I think, but I cannot see the problem. The script searchdata is run dynamically through another script count2 (onkeyup) . I wish the same thing for the checkboxes, so when the checkboxes are ticked, the corresponding results are shown immediately.
Hope I have made myself clear and thanks!
VBScript containing the search filter
sub searchdata
If acheck.Checked = True AND ucheck.Checked = False Then
Chkboxval = "A"
End If
If acheck.Checked = False AND ucheck.Checked = True Then
Chkboxval = "U"
End If
If acheck.Checked = True AND ucheck.Checked = True Then
Chkboxval = "U' OR Type='A"
End If
If acheck.Checked = False AND ucheck.Checked = False Then
MsgBox ("Select a filter")
End If
SQL_query = "SELECT * FROM arbejde WHERE Title LIKE '%"& txtsrch.value &"%' AND Type='" & Chkboxval & "' ORDER BY Title"
Set rsData = conn.Execute(SQL_query)
strHTML2 = strHTML2 & "<table class='detail' cellpadding='0' cellspacing='0' id='detail' border=0 width='97%'><col style='width: 60%;'><col style='width: 31%;'><col style='width: 9%;'><thead><tr><th colspan='4' align='left'></th></tr></thead>"
If rsData.EOF = True Then
strHTML2 = strHTML2 & "<span style='color: red'>Ingen resultater!</span><br><a onClick='addNotat()' style='cursor: hand'>Klik her for at oprette et nyt notat</a>"
End If
Do Until rsData.EOF = True
If (rsData("Length") <> "") Then
infopic = "info-on"
infolink = "onclick=window.open('" & rsData("Length") & "')"
ELSE
infopic = "info-off"
infolink = ""
End IF
strHTML2 = strHTML2 & "<tbody id='bodytext'><tr class='parent' id='trparent' style='font-weight: bold;'><td id='title' height='21'>" & rsData("Title") & "</td><td id='kategori'>" & rsData("Cat") & " (" & rsData("Type") & ")</td><td align='right' id='tools'><img src='images/icons/"& infopic & ".png' width='13' height='13' title='Gå til forretningsgangen' "& infolink & "> <img src='images/icons/edit1.png' width='13' height='13' title='Rediger' onclick='editUser("& rsData("ID") &")' language='vbscript'> <img src='images/icons/slet1.png' width='13' height='13' onclick='deleteUser("& rsData("ID") &")' title='Slet' language='vbscript'> </td></tr><tr class='child'><td colspan='5' id='notat' height='21'>" & rsData("Notes") & "</td></tr></tbody>"
rsData.moveNext ' go to next record
Loop
strHTML2 = strHTML2 & "</table>"
searchIT.innerHTML = strHTML2
end sub
Checkboxes:
<input type="checkbox" name="acheck" onclick="searchdata" id="acheck" checked>
<input type="checkbox" name="ucheck" onclick="searchdata" id="ucheck" checked>
Search input:
<input language="vbscript" onload="searchdata" onkeyup="count2" name="txtsrch" id="searchbar" width="15%" tabindex="0" size="35" type="text">
For starters, figure out if the error is raised in your database-engine or VBscript. To test the first possibility, I'd look at your SQL string:
SQL_query = "SELECT * FROM ... WHERE ... Type='" & Chkboxval & "' ..."
Set rsData = conn.Execute(SQL_query)
What happens if you set the SQL (instead of using the form)? There are only three check-box variants, so testing is easy:
Chkboxval = "A"
Chkboxval = "U"
Chkboxval = "U' OR Type='A"
I pasted them here to point out your approach to filling Chkboxval is awkward and I'm wondering if the database-engine is choking. So, try:
SQL_query = "SELECT * FROM arbejde WHERE Title LIKE '%test%' AND Type='A'"
If your three variants all work well, then look at the scripting. This should all be pretty easy to trouble shoot: Just "hand-code" test values until you find something that runs. Work from the simple to the complex, isolate the problem.
Figured it out myself. Apparently the function searchdata has to be called like searchdata(). This solved this problem but brought other problems, which I now have to face :-) Thanks to Smandoli for the suggestions.
Before
<input type="checkbox" name="acheck" onclick="searchdata" id="acheck" checked>
Solution
<input type="checkbox" name="acheck" onclick="searchdata()" id="acheck" checked>

Forward an email and append additional text without losing format of original message

I'm trying to forward an email that I received and append an additional message on top of it. The following code I wrote kinda does this, but I lose all the formatting of the original message. Is there any way to maintain the format of the original message and yet able to append additional test to the email?
MY CODE:
Sub xForward()
myMessage = "You recently requested access to the table. We are requiring all requests to complete a mandatory training session." & vbCr & vbCr & "Thank you, " & vbCr & "Ricky"
Dim itmOld As MailItem, itmNew As MailItem
Set itmOld = ActiveInspector.CurrentItem
Set itmNew = itmOld.Forward
itmNew.Body = myMessage & vbCr & vbCr & itmOld.Body
itmNew.Subject = "Access Request"
itmNew.Display
Set itmOld = Nothing
Set itmNew = Nothing
End Sub
If I don't update the body of itmNew, then I maintain the format of the original message. The moment I update itmNew.Body, then itmOld.Body is written in simple text and I lose all the formatting.
I think JP's comment points you in the right direction but I assume your questions results from limited knowledge of HTML. This is not a complete tutorial on HTML but I hope it gets your started.
If you use Debug.Print to output .HTMLBody to the immediate window you will see something like:
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html
xmlns="http://www.w3.org/1999/xhtml"> <head>
Lots of stuff here
</head> <body>
Lots of stuff here
</body> </html>
You will only get "<!DOCTYPE html ... " if the package that created the message supports the XML version of HTML. The minimum you should see is:
<html><head> Lots of stuff here </head><body> Lots of
stuff here </body></html>
If you place your extra message in front or at the end of this then you are breaking the rules of HTML. What happens will depend on how forgiving the receiver's email package is. To conform to the rules of HTML, you must place your extra message somewhere between "<body>" and "</body>".
If you look through a few messages, you will see how much they can vary. Some will be black text on white, some white text on black with every variation in between. Your message must be readable no matter what the message's authors have done. My suggestion is you create a one cell table at the top and you set the font and background colours. Try the following and then adapt it to your requirements:
Dim AddedMsg As String
Dim Pos As Long
' Create message to be inserted
' =============================
' Start a table with white background and blue text
AddedMsg = "<table border=0 width=""100%"" style=""Color: #0000FF"" bgColor=#FFFFFF>"
' Add row with single cell
AddedMsg = AddedMsg & "<tr><td><p>Cool stuff you must see!!</p></td></tr>"
' End table
AddedMsg = AddedMsg & "</table>"
' Code to add message once you have checked there is an HTML body
'================================================================
Pos = InStr(1, LCase(.HTMLBody), "<body")
If Pos = 0 Then
' This should be impossible.
Call MsgBox("<Body> element not found in HTML body", vbCritical)
' Code to handle impossible situation
End If
Pos = InStr(Pos, .HTMLBody, ">")
If Pos = 0 Then
' This should be impossible.
Call MsgBox("Terminating > for <Body> element not found in HTML body", vbCritical)
' Code to handle impossible situation
End If
'Insert your message
.HTMLBody = Mid(.HTMLBody, 1, Pos) & AddedMsg & Mid(.HTMLBody, Pos + 1)

VB.NET - Click Submit Button on Webbrowser page

I have a html page open on my webbrowser object, I can enter username and password okay, but I'm stuck and don't know how to submit the info. Here is the html code for the username/password submit:
<div id="signin">
<h2 class="ir">
<em></em>Sign in</h2>
<form action="/login/" method="post">
<input id="login-url" name="login[url]"
type="hidden" value="/characters/" />
<input id="login-urlError" name="login[urlError]"
type="hidden" value="/account/?error=1" />
<fieldset>
<ul>
<li class="row">
<label for="login-username">
Username <span class="req">*</span>
</label>
<input id="login-username" name="login[username]"
type="text" class="TextBox" value="" />
</li>
<li class="row">
<label for="login-password">
Password <span class="req">*</span>
</label>
<input id="login-password" name="login[password]"
type="password" class="TextBox Password" value="" />
</li>
<li class="but">
<input name="login[submit]" type="image"
class="img" alt="Login »"
src="/_pub/img/hp/but-login.png" />
</li>
</ul>
</fieldset>
</form>
<p>
ACCOUNT TROUBLE?
</p>
</div>
I use the following to enter the username and password:
WebBrowser1.Document.GetElementById("login-username").SetAttribute("Value", Information.txtuser.Text)
WebBrowser1.Document.GetElementById("login-password").SetAttribute("Value", Information.txtpass.Text)
What should I use to submit the info now? I tried getting the element by name and kept getting index out of range error, index should be -1 or 0, but it was.
Your help would be greatly appriecated!!
WebBrowser1.Document.GetElementById(*element id string*).InvokeMember("submit")
I searched for any solution to not use the "SendKeys(CHR(13))" methode I ever used to submit stuff in Browser. In this case I was happy to see your
InvokeMember("click")
but dont know why you know that you have to write "click" in there.
Anyway
Thanks
This is my solution for something similar to this problem:
System.Windows.Forms.WebBrowser www;
void VerificarWebSites()
{
www = new System.Windows.Forms.WebBrowser();
www.DocumentCompleted += new WebBrowserDocumentCompletedEventHandler(www_DocumentCompleted_login);
www.Navigate(new Uri("http://www.meusite.com.br"));
}
void www_DocumentCompleted_login(object sender, WebBrowserDocumentCompletedEventArgs e)
{
www.DocumentCompleted -= new WebBrowserDocumentCompletedEventHandler(www_DocumentCompleted_login);
www.DocumentCompleted += new WebBrowserDocumentCompletedEventHandler(www_DocumentCompleted_logado);
www.Document.Forms[0].All["tbx_login"].SetAttribute("value", "Gostoso");
www.Document.Forms[0].All["tbx_senha"].SetAttribute("value", "abcdef");
www.Document.GetElementById("btn_login").Focus();
www.Document.GetElementById("btn_login").InvokeMember("click");
}
void www_DocumentCompleted_logado(object sender, WebBrowserDocumentCompletedEventArgs e)
{
System.IO.StreamWriter sw = new StreamWriter("c:\\saida_teste.txt");
sw.Write(www.DocumentText);
sw.Close();
MessageBox.Show(e.Url.AbsolutePath);
}
This seems to work easily.
Public Function LoginAsTech(ByVal UserID As String, ByVal Pass As String) As Boolean
Dim MyDoc As New mshtml.HTMLDocument
Dim DocElements As mshtml.IHTMLElementCollection = Nothing
Dim LoginForm As mshtml.HTMLFormElement = Nothing
ASPComplete = 0
WB.Navigate(VitecLoginURI)
BrowserLoop()
MyDoc = WB.Document.DomDocument
DocElements = MyDoc.getElementsByTagName("input")
For Each i As mshtml.IHTMLElement In DocElements
Select Case i.name
Case "seLogin$UserName"
i.value = UserID
Case "seLogin$Password"
i.value = Pass
Case Else
Exit Select
End Select
frmServiceCalls.txtOut.Text &= i.name & " : " & i.value & " : " & i.type & vbCrLf
Next i
'Old Method for Clicking submit
'WB.Document.Forms("form1").InvokeMember("submit")
'Better Method to click submit
LoginForm = MyDoc.forms.item("form1")
LoginForm.item("seLogin$LoginButton").click()
ASPComplete = 0
BrowserLoop()
MyDoc= WB.Document.DomDocument
DocElements = MyDoc.getElementsByTagName("input")
For Each j As mshtml.IHTMLElement In DocElements
frmServiceCalls.txtOut.Text &= j.name & " : " & j.value & " : " & j.type & vbCrLf
Next j
frmServiceCalls.txtOut.Text &= vbCrLf & vbCrLf & WB.Url.AbsoluteUri & vbCrLf
Return 1
End Function
I am quite benefited with http://stackoverflow.com. I was wandering from hours for automatic login and submit from vb application to another web site. Due to help of this site I am able to complete my task
I have to login following web php page.
<HTML>
<body>
<div align="center"><img src="banner.png" height="80px" /></div>
<script type="text/javascript">
$(document).ready(function(){
$("#login").validate();
$("#login_container").css({'position': 'absolute',
'top' : (($(window).height()/2) - $("#login_container").height()/2)+'px'});
$("#login_container").css({'left' : (($(window).width()/2) - $("#login_container").width()/2)+'px'});
});
</script>
<div id="login_container">
<form name="login" id="login" action="?q=login" method="post">
<table>
<tr><td>Username</td><td><input type="text" name="name" class="required"/></td></tr>
<tr><td>Password</td><td><input type="password" name="password" class="required"/></td></tr>
<tr><td></td><td><input type="submit" name="subimt" value="Login" /></td></tr>
</table>
</form>
</div>
</body>
</html>
For automatic Login and clicking I wrote following VB.Net Code. In form1 I placed a button and a Webbrowser control
Imports System.IO
Imports System.Windows.Forms
Public Class Form1
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
WebBrowser1.Navigate("http://xyz.com")
End Sub
Private Sub WebBrowser1_DocumentCompleted(ByVal sender As Object, ByVal e As System.Windows.Forms.WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted
WebBrowser1.Document.GetElementById("name").SetAttribute("Value", "bharatlal")
WebBrowser1.Document.GetElementById("password").SetAttribute("Value", "mahato")
WebBrowser1.Document.GetElementById("subimt").Focus()
WebBrowser1.Document.GetElementById("subimt").InvokeMember("click")
End Sub
End Class
You could try giving an ID to the form, in order to get ahold of it, and then call form.submit() from a Javascript call.
Private Sub bt_continue_Click(sender As Object, e As EventArgs) Handles bt_continue.Click
wb_apple.Document.GetElementById("phoneNumber").Focus()
wb_apple.Document.GetElementById("phoneNumber").InnerText = tb_phonenumber.Text
wb_apple.Document.GetElementById("reservationCode").Focus()
wb_apple.Document.GetElementById("reservationCode").InnerText = tb_regcode.Text
'SendKeys.Send("{Tab}{Tab}{Tab}")
'For Each Element As HtmlElement In wb_apple.Document.GetElementsByTagName("a")
'If Element.OuterHtml.Contains("iReserve.sms.submitButtonLabel") Then
'Element.InvokeMember("click")
'Exit For
' End If
'Next Element
wb_apple.Document.GetElementById("smsPageForm").Focus()
wb_apple.Document.GetElementById("smsPageForm").InvokeMember("submit")
End Sub
Just follow two steps for clicking a any button using code.
focus the button or element which you want to click
WebBrowser1.Document.GetElementById("place id here").Focus()
simulate mouse click using this following code
SendKeys.Send("{ENTER}")