Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
This question does not appear to be about a specific programming problem, a software algorithm, or software tools primarily used by programmers. If you believe the question would be on-topic on another Stack Exchange site, you can leave a comment to explain where the question may be able to be answered.
Closed 3 years ago.
Improve this question
The left speaker of my laptop is not working well so I need to decrease left speaker level to 0% every time I use it. But whenever I need to use headphone I have to reverse it to 100% for left headphone.
I am here to find a solution through CMD. where I can switch from 0% to 100% volume of my left speaker using a .bat file.
Is there any way to control
speaker >> speaker properties >> levels >> balance
using command prompt?
Note: I have win10 (64bit)
If you want to do it in batch script, just save this code below as Switch_Mute_Volume.bat
So, When you double click on this batch script the volume switch from Volume (no mute) to mute. and when you repeat this action another time the volume switch from mute to no mute
#echo off
Title Switch Mute Speaker Volume
(echo CreateObject("WScript.Shell"^).SendKeys chr(173^))>"%Temp%\%~n0.vbs"
cscript //NoLogo "%Temp%\%~n0.vbs"
And if you want just to do it only in vbscript : Just save this code below Switch_Mute_Volume.vbs
CreateObject("WScript.Shell").SendKeys chr(173)
Here is another method using a HTML Application HTA If you want to use a GUI : Just copy and paste this code below as Switch_Mute_Volume.hta
<html>
<head>
<HTA:APPLICATION
APPLICATIONNAME="Volume + - ON/OFF"
BORDER="THIN"
BORDERSTYLE="NORMAL"
ICON="SndVol.exe"
INNERBORDER="NO"
MAXIMIZEBUTTON="NO"
MINIMIZEBUTTON="NO"
SCROLL="NO"
SELECTION="NO"
SINGLEINSTANCE="YES"/>
<title>Switch Volume + - ON/OFF </title>
<script language="vbscript">
'************************************************************************************
Sub window_onload()
CenterWindow 250,150
End Sub
'************************************************************************************
Sub Volume(Param)
set oShell = CreateObject("WScript.Shell")
Select Case Param
Case "MAX"
oShell.SendKeys "{" & chr(175) & " 50}" ' volume maximum 100%
Case "MIN"
oShell.SendKeys "{" & chr(174) & " 50}" 'volume minimum 0%
Case "UP"
oShell.SendKeys "{" & chr(175) & " 10}" 'volume +20%
Case "DOWN"
oShell.SendKeys "{" & chr(174) & " 10}" 'volume +20%
Case "MUTE"
oShell.SendKeys chr(173) 'allows to mute / reset the sound (switch)
End select
End Sub
'*************************************************************************************
Sub Volume(Param1,Param2,Param3)
set oShell = CreateObject("WScript.Shell")
oShell.SendKeys Param1 & chr(Param2) & Param3
'--------------------------- MEMO ----------------------------------
'oShell.SendKeys "{" & chr(175) & " 50}" ' volume maximum 100%
'oShell.SendKeys "{" & chr(174) & " 50}" 'volume minimum 0%
'oShell.SendKeys "{" & chr(175) & " 10}" 'volume +20%
'oShell.SendKeys "{" & chr(174) & " 10}" 'volume +20%
'oShell.SendKeys chr(173) 'allows to mute / reset the sound (switch)
End Sub
'*************************************************************************************
Sub CenterWindow(x,y)
Dim iLeft,itop
window.resizeTo x,y
iLeft = window.screen.availWidth/2 - x/2
itop = window.screen.availHeight/2 - y/2
window.moveTo ileft,itop
End Sub
'************************************************************************************
</script>
</head>
<body>
<center>
<BUTTON onClick="Call Volume('{','175',' 50}')" style="background: Red; color: white;WIDTH: 85px; HEIGHT: 30px">Volume MAX</BUTTON>
<BUTTON onClick="Call Volume('{','174',' 50}')" style="background: Blue; color: white;WIDTH: 85px; HEIGHT: 30px">Volume MIN</BUTTON>
<BUTTON onClick="Call Volume('{','175',' 10}')" style="background: Green; color: white;WIDTH: 85px; HEIGHT: 30px">Volume +20%</BUTTON>
<BUTTON onClick="Call Volume('{','174',' 10}')" style="background: Orange; color: white;WIDTH: 85px; HEIGHT: 30px">Volume -20%</BUTTON>
<BUTTON onClick="Call Volume('','173','')" style="background: DarkOrange; color: white;WIDTH: 85px; HEIGHT: 30px">ON/OFF</BUTTON>
</center>
</body>
</html>
Here a screenshot of this HTA :
Related
This question already has answers here:
Inputbox() function in vbs
(2 answers)
Closed 2 months ago.
I need to change icon on left corner to atts.ico.
I tried
message=InputBox("ATTS","atts.ico","Enter text to speech.")
But it didn't work...
Refer to this link Multiline inputbox via HTA written by omegastripes
Just change the path to your icon in this line on this vbscript below : %windir%\system32\notepad.exe and give a test for it
dim completed,INPUT
INPUT=inputboxml("Enter text:", "Multiline inputbox via HTA", "default" & vbcrlf & vbtab & "multiline" & vbcrlf & "text")
CreateObject("SAPI.spVoice").speak INPUT
function inputboxml(prompt, title, defval)
set window = createwindow()
completed = 0
defval = replace(replace(replace(defval, "&", "&"), "<", "<"), ">", ">")
with window
with .document
.title = title
.body.style.background = "buttonface"
.body.style.fontfamily = "consolas, courier new"
.body.style.fontsize = "8pt"
.body.innerhtml = "<div><center><nobr>" & prompt & "</nobr><br><br></center><textarea id='hta_textarea' style='font-family: consolas, courier new; width: 100%; height: 580px;'>" & defval & "</textarea><br><button id='hta_cancel' style='font-family: consolas, courier new; width: 85px; margin: 10px; padding: 3px; float: right;'>Cancel</button><button id='hta_ok' style='font-family: consolas, courier new; width: 85px; margin: 10px; padding: 3px; float: right;'>OK</button></div>"
end with
.resizeto 700, 700
.moveto 300, 50
end with
window.hta_textarea.focus
set window.hta_cancel.onclick = getref("hta_cancel")
set window.hta_ok.onclick = getref("hta_ok")
set window.document.body.onunload = getref("hta_onunload")
do until completed > 0
wscript.sleep 10
loop
select case completed
case 1
inputboxml = ""
case 2
inputboxml = ""
window.close
case 3
inputboxml = window.hta_textarea.value
window.close
end select
end function
function createwindow()
rem source http://forum.script-coding.com/viewtopic.php?pid=75356#p75356
dim signature, shellwnd, proc
on error resume next
signature = left(createobject("Scriptlet.TypeLib").guid, 38)
do
set proc = createobject("WScript.Shell").exec("mshta ""about:<head><script>moveTo(-32000,-32000);</script><hta:application id=app border=dialog minimizebutton=no maximizebutton=no scroll=no showintaskbar=yes contextmenu=no selection=yes innerborder=no icon=""%windir%\system32\notepad.exe""/><object id='shellwindow' classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></object><script>shellwindow.putproperty('" & signature & "',document.parentWindow);</script></head>""")
do
if proc.status > 0 then exit do
for each shellwnd in createobject("Shell.Application").windows
set createwindow = shellwnd.getproperty(signature)
if err.number = 0 then exit function
err.clear
next
loop
loop
end function
sub hta_onunload
completed = 1
end sub
sub hta_cancel
completed = 2
end sub
sub hta_ok
completed = 3
end sub
Scenario: pull the information from a running HTA and update an INPUT field with the information on a updated every 1 second. The concept was to use the INPUT field as a sort of progress bar while working with thousands of files (like 12300+ files) so that it did not just sit there and do nothing for near half hour! The end result does not error, but the INPUT field remains empty.
Here is my code (I know it is "dirty" but I was using only for a test):
<meta http-equiv='X-UA-Compatible' content='IE=8; IE=7' />
<html>
<head>
<hta:application id=oHTA
border=none
caption=no
contextmenu=no
innerborder=yes
scroll=no
showintaskbar=no
/>
<style>
body{
padding: 0;
margin: 0;
background-color: #000;
display: flex;
align-items: center;
justify-content: center;
}
img{width:100%;height:100%;left:0;top:0;position:absolute;}
div{z-index:1;position:absolute;color:black;top:80%;width:100%;}
input{width:20%;color:red;background:transparent;}
</style>
</head>
<body style='text-align:center;background:black;' >
<div>
<button id=click>Click</button><br>
</div>
<input type=text id=myinput />
<script language="vbscript">
mm=self.location.pathname
curdir = split(mm,"\")
for x =0 to ubound(curdir)
settimeout "updater(curdir(x))",10000
next
sub click_onclick
self.close
end sub
function updater(xx)
set ii = document.getelementbyid("myinput")
ii.value=xx
end function
</script>
As LesFerch had mentioned, I did end up showing the file name that is being processed as well as a functional progress bar. There is too much code to enter the entire HTA contents here but this would give you a decent idea. The whole code is over 1000 lines as I included a Base64 encoded image. Essentially it was a test to rename mp3 files as such: find an entry of ", The" or ", A", remove said entry, add "The " or "A " to the beginning of the respective section whether it be artist or title. As it I have over 14000 MP3s, the code I originally made which worked very well, left the end user (in this case me!) wondering if it was still running. Today, that question is answered! The code is still ugly and I am sure it could be relieved of alot of dead space, but I am proud.
<body style='text-align:center;background:black;'>
<input type=text id="myinput" value="" />
<div style="width:100%;top:10px;text-align:center;" id="myDiv2"></div>
<div id="myDiv" style="font-size:32px;">
</div>
<div style="top:10%;left:0;width:100%;"><h2>TheA: The File Fixer</h2></div>
<button id="myButton" onclick="killvid()" >Close</button>
<button id="myAbout" onclick="bignews()" style="left:10%;">About</button>
<button id="myStart" onclick="startproc()" style="left:43%;">Start</button>
function myTime(xt)
set ws = createobject("wscript.shell")
xtr=0
do until xtr > xt
xtr = xtr+1
ws.Run "ping 127.0.0.1 -n 1", 0, true
loop
end function
function updater(xx,yy)
set ii = document.getelementbyid("myinput")
if len(ii.value) < 70 then
ii.value= ii.value & "|"
else
ii.value =""
end if
myTime(.25)
end function
function startproc()
window.moveto -19999, -19999
set s = document.getelementsbytagname("BUTTON")
for each b in s
b.style.display = "none"
next
set s = nothing
on error resume next
str = document.location.pathname
set ws = createobject("wscript.shell")
set fs = createobject("scripting.filesystemobject")
'Open the BrowseForFolder dialog
Set a2 = sa.BrowseForFolder( 0, "Select Folder",1,&h11&)
sp = a2.Self.Path
window.moveto screen.width / 2 - 900, screen.height /2 - 500
if err.number>0 then
set mb = document.getelementbyid("myButton")
set md = document.getelementbyid("myDiv")
md.innertext="Nothing ventured, Nothing gained!" &vbcrlf & "Please exit this window!"
mb.style.display="block"
exit function
'more of the function excerpted
if bfn <> dd then
fs.copyfile file.path, replace(file.path,bfn,dd),1
rrr = rrr+1
if instr(bfn,rr) then
fs.deletefile file.path
md.innertext = "Renaming " & bfn & " to " &vbcrlf & _
dd & vbcrlf & "Processing " & dtx & " files." & vbcrlf &_
"Please wait..."
elseif instr(bfn,ss) then
fs.deletefile file.path
dtx = dtx-1
md.innertext = "Renaming " & bfn & " to " &vbcrlf & _
dd & vbcrlf & "Processing " & dtx & " files." & vbcrlf &_
"Please wait..."
END IF
updater bfn,dd
end if
end function
I want to use WScript.Sleep() function with a mshta.exe one-liner from a batch (I don't want to write temporary files) but I receive a WScript undefined error.
As stated in this answer:
WScript is an object provided by the W|CScript.exe hosts; IExplorer or
MSHTA don't provide it (see here).
In Sleep routine for HTA scripts:
Stephen Quan's answer
uses window.setTimeOut and window.ResizeTo which just threw
errors (but maybe there is a way to do it that I don't find).
uk2015's is VBScript.
iRon's: error in
character 5 ';' expected; also, the select has single quotes (in
mshta, the parameter is double-quoted and you can use single quotes
inside, but this is third level of quotification, so to speak. Furthermore, you need admin rights.
TorATB's: uses a ping! Same problem with quotes too.
I don't know how to make a single answer of these work or if possible.
Inside a .js run by c/wscript it works perfectly. Is there a replacement or a way to reference this function for mshta.exe?
Example:
Save the following code as .js and run it.
new ActiveXObject('Internet.HHCtrl').TextPopup('Warning message', 'Tahoma, 16, , BOLD', 8, 4, 0x0000FF, 0x00FFFF );WScript.Sleep(5000);
But, as I said, I want to run it from a batch without any temporary .js (or .vbs). Try running this code from a Command Prompt:
mshta "javascript:new ActiveXObject('Internet.HHCtrl').TextPopup('Warning message', 'Tahoma, 16, , BOLD', 8, 4, 0x0000FF, 0x00FFFF );close()"
The text popup opens and closes immediately but you can manage to see it sometimes. How do you manage to hold the text during a given amount of time when you run this code using mshta?
Here is a complete example showing you how to make a sleep with a HTA
<html>
<head>
<HTA:APPLICATION
APPLICATIONNAME="Volume + - ON/OFF"
BORDER="THIN"
BORDERSTYLE="NORMAL"
ICON="SndVol.exe"
INNERBORDER="NO"
MAXIMIZEBUTTON="NO"
MINIMIZEBUTTON="NO"
SCROLL="NO"
SELECTION="NO"
SINGLEINSTANCE="YES"/>
<title>Volume + - ON/OFF </title>
<script language="vbscript">
'************************************************************************************
Sub window_onload()
CenterWindow 250,150
End Sub
'************************************************************************************
Sub Sleep(MSecs)' Function to pause because wscript.sleep does not work with HTA
Set fso = CreateObject("Scripting.FileSystemObject")
Dim tempFolder : Set tempFolder = fso.GetSpecialFolder(2)
Dim tempName : tempName = "Sleeper.vbs"
If Not Fso.FileExists(tempFolder&"\"&tempName) Then
Set objOutputFile = fso.CreateTextFile(tempFolder&"\"&tempName, True)
objOutputFile.Write "wscript.sleep WScript.Arguments(0)"
objOutputFile.Close
End If
CreateObject("WScript.Shell").Run tempFolder&"\"&tempName &" "& MSecs,1,True
End Sub
'************************************************************************************
Sub Volume(Param)
set oShell = CreateObject("WScript.Shell")
Select Case Param
Case "MAX"
oShell.run "%SystemRoot%\System32\SndVol.exe" 'Runs The Master Volume App.
Sleep 2000 'Waits For The Program To Open
oShell.SendKeys("{HOME}")' volume maximum 100%
Sleep 100
oShell.SendKeys"%{F4}" ' ALT + F4
Case "MIN"
oShell.run "%SystemRoot%\System32\SndVol.exe" 'Runs The Master Volume App.
Sleep 2000 'Waits For The Program To Open
oShell.SendKeys("{END}") 'volume minimum 0%
Sleep 1000
oShell.SendKeys"%{F4}" ' ALT + F4
Case "UP"
oShell.run "%SystemRoot%\System32\SndVol.exe" 'Runs The Master Volume App.
Sleep 2000 'Waits For The Program To Open
oShell.SendKeys("{PGUP}") 'volume +20%
Sleep 1000
oShell.SendKeys"%{F4}" ' ALT + F4
Case "DOWN"
oShell.run "%SystemRoot%\System32\SndVol.exe" 'Runs The Master Volume App.
Sleep 2000 'Waits For The Program To Open
oShell.SendKeys("{PGDN}") 'Turns Up The Volume 20, If It Is Muted Then It Will Unmute It
Sleep 1000
oShell.SendKeys"%{F4}" ' ALT + F4
Case "MUTE"
oShell.run "%SystemRoot%\System32\SndVol.exe" 'Runs The Master Volume App.
Sleep 1000 'Waits For The Program To Open
oShell.SendKeys(" " & chr(173)) 'permet de couper/remettre le son (bascule)
Sleep 1000
oShell.SendKeys"%{F4}" ' ALT + F4
End select
End Sub
'*************************************************************************************
Sub CenterWindow(x,y)
Dim iLeft,itop
window.resizeTo x,y
iLeft = window.screen.availWidth/2 - x/2
itop = window.screen.availHeight/2 - y/2
window.moveTo ileft,itop
End Sub
'************************************************************************************
</script>
</head>
<body>
<center>
<BUTTON style="background: Red; color: white;" onClick="Call Volume('MAX')" style="WIDTH: 85px; HEIGHT: 30px">Volume MAX</BUTTON>
<BUTTON style="background: Blue; color: white;" onClick="Call Volume('MIN')" style="WIDTH: 85px; HEIGHT: 30px">Volume MIN</BUTTON>
<BUTTON style="background: Green; color: white;" onClick="Call Volume('UP')" style="WIDTH: 85px; HEIGHT: 30px">Volume +20%</BUTTON>
<BUTTON style="background: Orange; color: white;" onClick="Call Volume('DOWN')" style="WIDTH: 85px; HEIGHT: 30px">Volume -20%</BUTTON>
<BUTTON style="background: DarkOrange; color: white;" onClick="Call Volume('MUTE')" style="WIDTH: 85px; HEIGHT: 30px">ON/OFF</BUTTON>
</center>
</body>
</html>
Based on your edit question, you can do something like this with a batch file :
#echo off
Title Execute a .JS and .VBS file in a batch script
echo Hello World !
Set "JS_Warning=%Temp%\Warning.js"
Set "VBS_Msg=%Temp%\Msg.vbs"
REM Create a .js temporary file
echo new ActiveXObject('Internet.HHCtrl'^).TextPopup('Warning message', 'Tahoma, 16, , BOLD', 8, 4, 0x0000FF, 0x00FFFF ^);WScript.Sleep(5000^);>"%JS_Warning%"
REM Create a .vbs temporary file
echo CreateObject("Internet.HHCtrl"^).TextPopup "Hello !" ^& vbCrLf ^& "How are you ?", "Verdana,8", 6, 6, 6, 6 : WScript.Sleep 5000>"%VBS_Msg%"
REM We execute the .js file
Wscript "%JS_Warning%"
REM We execute the .vbs file
Wscript "%VBS_Msg%"
Sub Sleep(lngDelay)
CreateObject("WScript.Shell").Run "Timeout /T " & lngDelay & " /nobreak", 0, True
End Sub
Sleep 1
Try WMI event notification query.
The following query example shows you how to generate events every second forever.
SELECT * FROM __InstanceModificationEvent WHERE TargetInstance ISA "Win32_LocalTime"
You could use SWbemServices.ExecNotificationQuery method to subscribe to events.
<html>
<head>
<title>Sleep</title>
<HTA:APPLICATION>
</head>
<body>
<script language="javascript">
window.resizeTo(640, 480);
var CIMv2 = GetObject("winmgmts:{impersonationLevel=impersonate}!\\\\.\\root\\CIMv2")
function sleep(count) {
var event_gen = CIMv2.ExecNotificationQuery("SELECT * FROM __InstanceModificationEvent WHERE TargetInstance ISA \"Win32_LocalTime\"")
for(var i = 0; i < count; i++) {
event_gen.NextEvent();
}
}
for(var i=0; i<3; i++) {
sleep(3)
alert("3 seconds passed")
}
document.write("<h1>Goodbye</h1>");
</script>
</body>
I am trying to make multiple inputbox in one userform using vbscript instead of displaying one inputbox at a time i want to show multiple inputbox at once and then take entry from all of them but was unable to find any solution on internet too.
In my code second input box is coming after taking input from first inputbox and vice versa instead i want to take all the inputs at once using vbscript only not vba
sInput = InputBox("Enter your name")
MsgBox ("You entered:" & sInput)
sInput1 = InputBox("Enter your Age")
MsgBox ("You entered:" & sInput1)
sInput2 = InputBox("Enter email id you want to send")
sInput3 = InputBox("Enter Subject")
sInput4 = InputBox("Enter Email Body")
I found a vbscript code from #omegastripes multiline_inputbox_via_hta.vbs
I don't know if this answer can give you an idea or not?
dim completed
msgbox inputboxml("Enter text:", "Multiline inputbox via HTA", "Enter your name : " & vbcrlf & "Enter your Age : " & vbcrlf &_
"Enter email id you want to send : " & vbcrlf & "Enter Subject : " & vbcrlf & "Enter Email Body : " )
function inputboxml(prompt, title, defval)
set window = createwindow()
completed = 0
defval = replace(replace(replace(defval, "&", "&"), "<", "<"), ">", ">")
with window
with .document
.title = title
.body.style.background = "buttonface"
.body.style.fontfamily = "consolas, courier new"
.body.style.fontsize = "8pt"
.body.innerhtml = "<div><center><nobr>" & prompt & "</nobr><br><br></center><textarea id='hta_textarea' style='font-family: consolas, courier new; width: 100%; height: 400px;'>" & defval & "</textarea><br><button id='hta_cancel' style='font-family: consolas, courier new; width: 85px; margin: 10px; padding: 3px; float: right;'>Cancel</button><button id='hta_ok' style='font-family: consolas, courier new; width: 85px; margin: 10px; padding: 3px; float: right;'>OK</button></div>"
end with
.resizeto 550, 550
.moveto 100, 100
end with
window.hta_textarea.focus
set window.hta_cancel.onclick = getref("hta_cancel")
set window.hta_ok.onclick = getref("hta_ok")
set window.document.body.onunload = getref("hta_onunload")
do until completed > 0
wscript.sleep 10
loop
select case completed
case 1
inputboxml = ""
case 2
inputboxml = ""
window.close
case 3
inputboxml = window.hta_textarea.value
window.close
end select
end function
function createwindow()
rem source http://forum.script-coding.com/viewtopic.php?pid=75356#p75356
dim signature, shellwnd, proc
on error resume next
signature = left(createobject("Scriptlet.TypeLib").guid, 38)
do
set proc = createobject("WScript.Shell").exec("mshta ""about:<head><script>moveTo(-32000,-32000);</script><hta:application id=app border=dialog minimizebutton=no maximizebutton=no scroll=no showintaskbar=yes contextmenu=no selection=yes innerborder=no icon=""%windir%\system32\notepad.exe""/><object id='shellwindow' classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></object><script>shellwindow.putproperty('" & signature & "',document.parentWindow);</script></head>""")
do
if proc.status > 0 then exit do
for each shellwnd in createobject("Shell.Application").windows
set createwindow = shellwnd.getproperty(signature)
if err.number = 0 then exit function
err.clear
next
loop
loop
end function
sub hta_onunload
completed = 1
end sub
sub hta_cancel
completed = 2
end sub
sub hta_ok
completed = 3
end sub
Hello i have implemented my vbscript code in hta and it is working fine i am sharing my full code for future reference kindly paste it in notepad and save the notepad with .hta extension
(for your reference using vbscript i am trying to take input from user store it in excel with password protection and then send that excel file through outlook to the email id which user has provided --kindly note your outlook needs to be open and running before running this code and kindly provide some different excel path i have given my file path)
<HEAD>
<TITLE>Send Status of Task</TITLE>
<hta:application
applicationname="HTA Sample"
scroll="yes"
singleinstance'"yes"
>
</HEAD>
<SCRIPT language="vbscript">
Sub RunThisSubroutine
str1 = TextBox1.Value
str2 = TextBox2.Value
str3 = TextBox3.Value
str4 = TextBox4.Value
str5 = TextBox5.Value
msgBox str1 & ", " & str2 & ", " & str3 &"," & str4&"," & str5
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\Users\saurabh.ad.sharma\Desktop\rrr.xlsx")
objExcel.Application.Visible = True
objExcel.Sheets(1).unprotect "saurabh"
Set rg = objExcel.Sheets(1).Range("A1")
lr = rg.CurrentRegion.Rows.Count
With rg
.Offset(lr, 0).Value = str1
.Offset(lr, 1).Value = str2
End With
objExcel.ActiveWorkbook.Save
objExcel.Sheets(1).protect "saurabh"
objExcel.ActiveWorkbook.Save
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
Set objOutl = CreateObject("Outlook.Application")
Set objMailItem = objOutl.CreateItem(olMailItem)
objMailItem.Display
strEmailAddr = str3
objMailItem.Recipients.Add strEmailAddr
objMailItem.Subject=str4
objMailItem.Body = str5
objMailItem.Attachments.Add "C:\Users\saurabh.ad.sharma\Desktop\rrr.xlsx"
objMailItem.Send
Set objMailItem = nothing
Set objOutl = nothing
End Sub
</SCRIPT>
<BODY STYLE="FONT:10 pt verdana; COLOR:black; filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='#FFCC66', EndColorStr='#FFFFFF')">
Hyper Text Applications make it easy to add user inputs: <BR>
<label for="Name ">Name:</label>
<input type="text" name="TextBox1" size="30"><BR><BR>
<label for="Age">Age :</label>
<input type="text" name="TextBox2" size="30"><BR><BR>
<label for="Send Email to">Send Email to:</label>
<input type="text" name="TextBox3" size="30" ><BR><BR>
<label for="Subject ">Subject:</label>
<input type="text" name="TextBox4" size="30" ><BR><BR>
<label for="Body">Body:</label>
<input type="text" name="TextBox5" size="30" ><BR><BR>
<input id=runbutton class= "button" type="button" value="Run" name="button1" onClick="RunThisSubroutine">
</BODY>
I have a working vbscript form with some parts based on hta code.
The form is intended to open a incident in a ticketing tool. This is also working as expected.
I intend to do some adjustments, specially adding a background wallpaper or changing color, and also adding a logo (in jpg ou png) on the top left corner of the form. I think this can be changed on the hta part of the script but I tried to apply some modifications, so far without success.
Below is the code. Any clue? Thank you very much.
Sub GetParams(sTitle, sPrompt, oParams, bAccepted, iWidth, iHeight)
Dim oWnd, sContent, aKeys, i
sContent = "<div style='font: 8pt tahoma;'>"
aKeys = oParams.Keys
For i = 0 To oParams.Count - 1
sContent = sContent & "<span style='margin: 4px;'>" & HtmlSafe(aKeys(i)) & "</span><br>"
sContent = sContent & "<input id=textbox" & i & " value='" & HtmlSafe(oParams.Item(aKeys(i))) & "' type='textbox' style='font: 8pt tahoma; width: 100%; margin: 4px;'/><br>"
Next
sContent = sContent & "<br><input onclick='window.accepted=true;' type='button' value='Criar' style='font: 8pt tahoma; width: 75px; height: 21px; float: right; margin-right: 20px;'/></div>"
Set oWnd = CreateWindow()
With oWnd
With .Document
.Title = sTitle
.Body.Style.Background = "buttonface"
.Body.InnerHtml = sContent
End With
.ResizeTo iWidth, iHeight
.MoveTo CInt((.Screen.AvailWidth - iWidth) / 2), CInt((.Screen.AvailHeight - iHeight) / 2)
End With
oWnd.ExecScript "var accepted=false;"
On Error Resume Next
Do
bAccepted = oWnd.Accepted
If bAccepted Then Exit Do
If Err.Number <> 0 Then
bAccepted = False
Exit Sub
End If
WScript.Sleep 10
Loop
For i = 0 To oParams.Count - 1
oParams(aKeys(i)) = oWnd.Document.GetElementById("textbox" & i).Value
Next
oWnd.Close
End Sub
Function HtmlSafe(sText)
HtmlSafe = Replace(Replace(Replace(Replace(sText, "&", "&"), "<", "<"), ">", ">"), vbCrLf, "<br>")
End Function
Function CreateWindow()
Dim sSignature, oShellWnd, oProc
sSignature = Left(CreateObject("Scriptlet.TypeLib").Guid, 38)
Set oProc = CreateObject("WScript.Shell").Exec("mshta ""about:<html><head><script>moveTo(-32000,-32000);document.title=' '</script><hta:application id=app border=thick minimizebutton=no maximizebutton=no scroll=no showintaskbar=yes contextmenu=no selection=no innerborder=no icon=""""/><object id='shell' classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></object><script>shell.putproperty('" & sSignature & "',document.parentWindow);</script></head></html>""")
Do
If oProc.Status > 0 Then
Set CreateWindow = Nothing
Exit Function
End If
For Each oShellWnd In CreateObject("Shell.Application").Windows
On Error Resume Next
Set CreateWindow = oShellWnd.GetProperty(sSignature)
If Err.Number = 0 Then Exit Function
On Error Goto 0
Next
Loop
End Function
I suppose you want to include the image with your script, not reference one that already exists on disk. You can use CSS for that. Define the background-image property with a data URI like this:
background-image: url(data:image/png;base64,<base64-encoded image>);
Example data URI for a red 1px PNG image:
background-image: url(data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAABCAIAAACQd1PeAAAACXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH3goaER0v2K3gpwAAABl0RVh0Q29tbWVudABDcmVhdGVkIHdpdGggR0lNUFeBDhcAAAAMSURBVAjXY/jPwAAAAwEBABjdjbAAAAAASUVORK5CYII=);
If you don't have a tool for converting stuff to base64 you can use an online converter.
Repetition of images is controlled via the background-repeat property. For including a logo you could make the logo the background of a <div> with repetition set to no-repeat.
If you define the style in a <style></style> block you need to specify a selector, e.g.:
<style>
body {
background-image: url(data:image/png;base64,iVBORw0K...);
}
</style>
Otherwise you'll have to put it in the style attribute of a tag, e.g.:
<body style="background-image: url(data:image/png;base64,iVBORw0K...);">