I have an HTA that I want to pop into focus every hour as a reminder in case it's minimised or has the focus taken away from it. The problem I'm having is there's a Sub that's not recognising variables. I'll post the code and then explain:
<HTML>
<HEAD>
<style type="text/css">
p {font-family: 'Segoe UI Light'; font-size: 12pt}
td {font-family: 'Segoe UI Light'; font-size: 12pt}
input {font-family: 'Segoe UI Light'; font-size: 12pt}
body {font-family: 'Segoe UI Light'; font-size: 12pt; color: #4D4C5C; background-color: white}
</style>
<TITLE>QT MOE Upgrade</TITLE>
<HTA:APPLICATION ID="MOEUpgrade"
APPLICATIONNAME="MOE Upgrade"
BORDER="dialog"
SCROLL="no"
SHOWINTASKBAR="yes"
SINGLEINSTANCE="yes"
SYSMENU="no">
</HEAD>
<SCRIPT LANGUAGE="VBScript">
Dim iTimerID, strProcName, strProcID
Set objShell = CreateObject("WScript.Shell")
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colProcesses = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE '%MOEUpgrade.hta%'")
For Each objProcess in colProcesses
strProcName = objProcess.Name
strProcID = objProcess.ProcessID
Next
Sub Window_OnLoad
Set colItems = objWMIService.ExecQuery("Select * From Win32_VideoController WHERE AdapterDACType='Internal'")
For Each objItem in colItems
intHorizontal = objItem.CurrentHorizontalResolution
intVertical = objItem.CurrentVerticalResolution
Next
intLeft = (intHorizontal-1024)/2
intTop = (intVertical-600)/2
self.resizeto 1024,600
self.moveTo intLeft,intTop
self.focus()
iTimerID = window.setInterval("NagWindow",5000)
End Sub
Sub NagWindow
MsgBox strProcName & VBCRLF & strProcID
End Sub
Sub StartUpgradeNow
If MsgBox ("Are you sure you want to start the upgrade now?",vbYesNo+vbExclamation,"Confirm Upgrade") = vbYes Then
self.close()
End If
End Sub
</SCRIPT>
<BODY>
<div align="justify">
<p>
<br><br><br><br><br><br><br><br><br><br><br><br><br><br><br><br><br><br><br>
</p>
</div>
<div align="center">
<br>
<span class="tooltip" title="Click OK to start the upgrade now"><input type="button" name="OKButton" value=" OK " onClick="StartUpgradeNow" style="font-family: 'Segoe UI Light'"></span>
</div>
</BODY>
</HTML>
If you're so inclined, you can save this code as MOEUpgrade.hta and it should run for you without any issues. This code works and pops up a message box showing the strProcName and strProcID variables as expected, but when I change line 58 inside the NagWindow Sub to:
objShell.AppActivate strProcName.strProcID
It fails with an object required ('strProcName') error. Does anyone know why the variables are not being recognised when using the objShell function please but are when using MsgBox?
The reason for the error
Object required: 'strProcName'
is because you try to call strProcID as an object property of strProcName but it is clear from the code that both strProcName and strProcID are string variables.
If you are trying to use AppActivate with the Window Process Id you likely want to try;
Call objShell.AppActivate(strProcID)
Useful Links
WshShell.AppActivate doesn't seem to work in simple vbs script
Use AppActivate to change the active window
Related
I have an HTA application I would like to run from a Command Prompt.
I've tried everything I could possibly think of and it's just not working!
It just launches the application and that's it.
From Command Prompt I run it with the full path as such:
C:\users\xxx\script.hta "arg1" "arg2"
which is essentially what I'm trying to accomplish here?
I've gone through numerous pages on here with similar issues but I guess I'm just not putting it together properly!
Here is the code:
<html>
<head>
<HTA:Application
ID="oHTA"
APPLICATIONNAME="MSI-BUILD"
Border = "NO"
Singleinstance ="YES"
BorderStyle = "Complex"
ShowInTaskBar = "YES"
MaximizeButton = "No"
MinimizeButton = "No"
scroll="NO"
VERSION="2"
/>
<script language = "VBScript">
Sub RunProgram
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
strCurDir= WshShell.CurrentDirectory
StrARG = MSINAME.value
StrARG3 = FPath.value
strFolder = "D:\SMPSS\PROJECTS\"&MSINAME.value
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.FolderExists(strFolder) Then
oFSO.CreateFolder strFolder
End If
objShell.Run "D:\SMPSS\MSI-2\1-newproject.vbs " & StrARG , 0, True
window.close()
End Sub
Sub Window_onLoad
Self.Resizeto 890, 300
document.title = oHTA.applicationName & " v" & oHTA.version
arrCommands = Split(oHTA.commandLine, chr(34))
For i = 3 to (Ubound(arrCommands) - 1) Step 2
Select Case arrCommands(i)
Case "arg1"
myarg1 = "This is argument 1."
Case "arg2"
myarg2 = "This is argument 2."
End Select
Next
MsgBox myarg1
MsgBox myarg2
End Sub
</script>
</head>
<body style="background-color: #b2b2f4">
<td>MSI-NAME:</td>
<td> </td>
<td style="overflow:hidden">
<td style="resize:none">
<td style="text-align:right">
<td style="width: 325px"><input type = "text" name = "MSINAME" id = "MSINAME" size="50" /></td>
<p>
<td>PATH:</td>
<td> </td>
<td> </td>
<td> </td>
<td> </td>
<td> </td>
<td style="overflow:hidden"></td>
<td style="resize:none"></td>
<td style="text-align:right"></td>
<td style="width: 325px"><input type = "text" name = "FPath" id = "FPath" value ="" size="50" /></td>
<td> </td>
</p>
<p>
<input id='submit' type="button" value="Submit" onClick="RunProgram"></td>
</p>
</body>
</html>
I figured it out the issue was having <meta http-equiv="x-ua-compatible" content="ie=9"> in my code once removed everything started working as it should thanks! Also the file wasn't saved as ANSI so it was having invalid character errors. Everything is working great now!
I have a timer which I would like to start after a button is clicked versus using the now() variable on launch. I'm lifting the code from MSFT Script Centre. I believe the correct implementation would be to wrap the
pbStartTime = Now
line around an if argument. However, I'm not sure about the logic behind button clicked. Thanks in advance.
<html>
<title>Report Generation</title>
<head>
<HTA:APPLICATION
APPLICATIONNAME="Report Generation"
SCROLL="No"
CAPTION="yes"
MAXIMIZEBUTTON="no"
MINIMIZEBUTTON="no"
SINGLEINSTANCE="yes"
WINDOWSTATE="normal"
SYSMENU="no"
BORDER="thin"
BORDERSTYLE="Normal"
CONTEXTMENU="no"
SELECTION="no">
</head>
<style>
BODY
{
background-color: buttonface;
Font: arial,sans-serif
margin-top: 10px;
margin-left: 20px;
margin-right: 20px;
margin-bottom: 5px;
}
.button
{
width: 91px;
height: 25px;
font-family: arial,sans-serif;
font-size: 8pt;
}
td
{
font-family: arial,sans-serif;
font-size: 10pt;
}
#scroll
{
height:100%;
overflow:auto;
}
SELECT.FixedWidth
{
width: 17em; /* maybe use px for pixels or pt for points here */
}
</style>
<script language="vbscript">
Dim pbTimerID
Dim pbHTML
Dim pbWaitTime
Dim pbHeight
Dim pbWidth
Dim pbBorder
Dim pbUnloadedColor
Dim pbLoadedColor
Dim pbStartTime
Dim WinWidth : WinWidth = 350
Dim WinHeight : WinHeight = 330
Window.ResizeTo WinWidth, WinHeight
Sub Sleep(lngDelay)
CreateObject("WScript.Shell").Run "Timeout /T " & lngDelay & " /nobreak", 0, True
End Sub
Sub CheckBoxChange
If CheckBox(0).Checked Then
ExecuteScoreCard
Else
MsgBox "CheckBox is not checked"
End If
End Sub
Sub ExecuteScoreCard()
disablebtns
Dim sitecode
Dim objExcel
Dim objWorkbook
Dim objSheet
Window_OnLoad
dim fso: set fso = CreateObject("Scripting.FileSystemObject")
dim path: path = fso.GetAbsolutePathName(".")
Set objExcel = CreateObject("Excel.Application")
objExcel.Automationsecurity = 1
Set objWorkbook = objExcel.Workbooks.Open(path & "\SCORECARD.xlsm")
Set objSheet = objWorkbook.Worksheets("Cover Tab")
sitecode = document.getElementById("sitecode").value
objSheet.Cells(4, 2) = sitecode
objExcel.Run "SCORECARD.xlsm!Module2.RefreshConns"
Sleep 60
objExcel.ActiveWorkbook.SaveAs path & "\Scorecards\" & "Scorecard_" & sitecode & "_" & Year(Now()) & Month(Now()) & Day(Now()) & "_" & Hour(Now()) & Minute(Now()) &".xlsm", 52
objExcel.ActiveWorkbook.Close
objExcel.Quit
DoAction1
enablebtns
End Sub
Sub Window_OnLoad
' Progress Bar Settings
pbWaitTime = 180 ' How many seconds the progress bar lasts
pbHeight = 20 ' Progress bar height
pbWidth= 285 ' Progress bar width
pbUnloadedColor="white" ' Color of unloaded area
pbLoadedColor="black" ' Color of loaded area
pbBorder="grey" ' Color of Progress bar border
' Don't edit these things
pbStartTime = now()
rProgressbar
pbTimerID = window.setInterval("rProgressbar", 200)
end sub
Sub rProgressbar
pbHTML = ""
pbSecsPassed = DateDiff("s",pbStartTime,Now)
pbMinsToGo = Int((pbWaitTime - pbSecsPassed) / 60)
pbSecsToGo = Int((pbWaitTime - pbSecsPassed) - (pbMinsToGo * 60))
if pbSecsToGo < 10 then
pbSecsToGo = "0" & pbSecsToGo
end if
pbLoadedWidth = (pbSecsPassed / pbWaittime) * pbWidth
pbUnloadedWidth = pbWidth - pbLoadedWidth
pbHTML = pbHTML & "<table border=1 bordercolor=" & pbBorder & " cellpadding=0 cellspacing=0 width=" & pbWidth & "><tr>"
pbHTML = pbHTML & "<th width=" & pbLoadedWidth & " height=" & pbHeight & "align=left bgcolor=" & pbLoadedColor & "></th>"
pbHTML = pbHTML & "<th width=" & pbUnloadedWidth & " height=" & pbHeight & "align=left bgcolor=" & pbUnLoadedColor & "></th>"
pbHTML = pbHTML & "</tr></table><br>"
pbHTML = pbHTML & "<table border=0 cellpadding=0 cellspacing=0 width=" & pbWidth & "><tr>"
pbHTML = pbHTML & "<td align=center width=" & pbWidth & "% height=" & pbHeight & ">" & pbMinsToGo & ":" & pbSecsToGo & " remaining</td>"
pbHTML = pbHTML & "</tr></table>"
progressbar.InnerHTML = pbHTML
if DateDiff("s",pbStartTime,Now) >= pbWaitTime then
StopTimer
end if
End Sub
Sub disablebtns
btnSubmit.disabled = True
btnExit.disabled = True
end Sub
Sub enablebtns
btnSubmit.disabled = False
btnExit.disabled = False
end Sub
Sub StopTimer
window.clearInterval(PBTimerID)
End Sub
Sub DoAction1
MsgBox ("Successfully generated scorecard.")
End Sub
Sub DoAction2
MsgBox ("Successfully generated report2.")
End Sub
Sub DoAction3
MsgBox ("Successfully generated report3.")
End Sub
Sub ExitProgram
window.close()
End Sub
</script>
<body>
Site Code: <input type="inputbox" name="sitecode" id="sitecode">
<br><br>
<input type="checkbox" name="CheckBox"> Scorecard
<br>
<input type="checkbox" name="CheckBox"> Report2
<br>
<input type="checkbox" name="CheckBox"> Report3
<br>
<br>
<span id = "progressbar"></span>
<br>
<div align="center">
<input type="button" name="accept" id="btnSubmit" value="Submit" onclick="CheckBoxChange" style="height:30px; width:100px">
<input type="button" name="abort" id="btnExit" value="Exit" onClick="ExitProgram" style="height:30px; width:100px">
<br>
</body>
</html>
You could add a Start button, just like your ABORT button. Modify your Sub Window_OnLoad rename it to Sub StartProcess or something. Then in the new Start button that you created, add an onClick="StartProcess" attribute.
<input type="Button" value="START" name="button2" onClick="StartProcess" class="button">
I am trying to make this HTA working, what it does is to add up all value from each drop down list and search accordingly in a directory that can be selected from another button. I can only make the form of this HTA but dont know how to make the search working.
Also how can I move the directory selection button to the beginning of the line?
so user can pick up directory first then pick what they want to search.
<html>
<head>
<HTA:APPLICATION ID="2014-03"
applicationName="2014-03"
version="1.1"
BORDER="thin"
BORDERSTYLE="static"
CAPTION="Yes"
CONTEXTMENU="no"
ICON="C:\icon\32x32.ico"
INNERBORDER="no"
MAXIMIZEBUTTON="no"
MINIMIZEBUTTON="no"
NAVIGATABLE="no"
SCROLL="no"
SCROLLFLAT="no"
SELECTION="no"
SHOWINTASKBAR="yes"
SINGLEINSTANCE="yes"
SYSMENU="yes"
WINDOWSTATE="normal"
>
<SCRIPT LANGUAGE="VBScript">
Sub RunSearch_OnClick()
msgBox "Success!"
End Sub
Sub TestSub
For Each objOption in OptionChooser.Options
If objOption.Selected Then
Msgbox objOption.InnerText
End If
Next
End Sub
Sub TestSub1
For Each objOption in OptionChooser.Options
If objOption.Selected Then
Msgbox objOption.InnerText
End If
Next
End Sub
Sub WindowsLoad
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder (0, "Select The Folder To Enumerate :", (0))
If objFolder Is Nothing Then
Wscript.Quit
Else
Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path
End If
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder(objPath)
For each objFile in objFolder.Files
If objFolder.Files.Count > 0 Then
Window.Document.Title = "Information For " & objPath
strHtml = strHtml & "<td><Font color = Blue>" & objFile.Name & "</font></Br>"
DataArea.InnerHtml = strHtml
End If
Next
End Sub
</SCRIPT>
</head>
<body>
<select id=extension size="1" name="OptionChooser" onChange="TestSub">
<option value="0">Selet File Type</option>
<option value="1">.txt</option>
<option value="2">.pdf</option>
<option value="3">.jpg</option>
<option value="4">.mp3</option>
</select>
<select id=year size="1" name="OptionChooser" onChange="TestSub1">
<option value="0">Select Year</option>
<option value="1">2014</option>
<option value="2">2013</option>
<option value="3">2012</option>
<option value="3">2011</option>
<option value="3">2010</option>
</select>
<select id=month size="1" name="OptionChooser" onChange="TestSub2">
<option value="0">Select Month</option>
<option value="1">01</option>
<option value="2">02</option>
<option value="3">03</option>
<option value="1">04</option>
<option value="2">05</option>
<option value="3">06</option>
<option value="1">07</option>
<option value="2">08</option>
<option value="3">09</option>
<option value="1">10</option>
<option value="2">11</option>
<option value="3">12</option>
</select>
<input Type = "Button" Value = "Browse For Folder" Name = "Run_Button" onClick = "WindowsLoad"><p></td>
<input type="button" value="Search" name="RunSearch">
</body>
</html>
The final HTA should look like this, the search result need to be displayed below the drop down list as text file within a scrollable window and having full path of the files.
In next HTA only necessary changes made to display the search result below the drop down list as a scrollable text area and having full paths of the files.
On start, a user is prompted to select initial directory (see WindowsLoad call within the Window_Onload procedure; then all files are displayed as no search criteria selected yet.
Search completed in code for extension only to show a possible how-to approach (one of few).
Used a simple StyleSheet.
Some variables defined script (application) global to keep their visibility within all procedures.
Further elementary changes: see the code below.
The code:
<html>
<head>
<HTA:APPLICATION ID="2014-03"
applicationName="2014-03"
version="1.1"
BORDER="thin"
BORDERSTYLE="static"
CAPTION="Yes"
CONTEXTMENU="no"
ICON="C:\icon\32x32.ico"
INNERBORDER="no"
MAXIMIZEBUTTON="no"
MINIMIZEBUTTON="no"
NAVIGATABLE="no"
SCROLL="no"
SCROLLFLAT="no"
SELECTION="no"
SHOWINTASKBAR="yes"
SINGLEINSTANCE="yes"
SYSMENU="yes"
WINDOWSTATE="normal"
>
<!--
'************************
'* StyleSheet
'************************
-->
<style>
BODY
{
background-color: buttonface;
font-family: Arial, Helvetica, sans-serif;
font-size: 8pt;
margin-top: 2px;
margin-left: 8px;
margin-right: 3px;
margin-bottom: 3px;
}
.button
{
font-family: Arial, Helvetica, sans-serif;
font-size: 8pt;
width: 40px;
}
textarea
{
background-color: yellow;
font-family: Arial;
font-size: 8pt;
margin-left: 3px;
margin-right: 3px;
}
</style>
<SCRIPT LANGUAGE="VBScript">
'************************
'* Global Variables
'************************
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
objPath = ""
strHtml = ""
Chooser0 = ""
Chooser1 = ""
Chooser2 = ""
'************************
'* Window_Onload
'************************
Sub Window_Onload
self.Focus()
self.ResizeTo 800,600
DataArea.InnerHTML = "<textarea cols=122 rows=25></textarea>"
WindowsLoad
End Sub
Sub RunSearch_OnClick()
'msgBox "Success!"
WindowsLoad
End Sub
Sub TestSub
If OptionChooser.Value = "0" Then
Chooser0 = ""
Else
For Each objOption in OptionChooser.Options
If objOption.Selected Then
Chooser0 = objOption.InnerText
Exit For
End If
Next
End If
End Sub
Sub TestSub1
For Each objOption in OptionChooser1.Options
If objOption.Selected Then
Msgbox objOption.InnerText
End If
Next
End Sub
Sub TestSub2
For Each objOption in OptionChooser2.Options
If objOption.Selected Then
Msgbox objOption.InnerText
End If
Next
End Sub
Sub whichFolder
prevPath = objPath
Set objFolder = objShell.BrowseForFolder _
(0, "Select The Folder To Enumerate :", (0))
If objFolder Is Nothing Then
msgBox "Bye!"
self.Close()
Else
Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path
End If
If prevPath <> "" then WindowsLoad
End Sub
Sub WindowsLoad
If objPath = "" Then
whichFolder
End If
Set objFolder = objFso.GetFolder(objPath)
Window.Document.Title = "Information For " & objPath & " " & Chooser0
strHtml = "<textarea cols=122 rows=25>"
ShowSubFolders objFolder, Chooser0
DataArea.InnerHtml = strHtml
End Sub
Sub ShowSubFolders(fFolder, strExt)
'strHtml = strHtml & Chr(10) & fFolder.Path & Chr(10)
Set objFolder = objFSO.GetFolder(fFolder.Path)
Set colFiles = objFolder.Files
For Each objFile in colFiles
If strExt = "" OR UCase(strExt) = _
"." & UCase(objFSO.GetExtensionName(objFile.name)) Then
strHtml = strHtml & objFile.Path & Chr(10)
End If
Next
For Each Subfolder in fFolder.SubFolders
ShowSubFolders Subfolder, strExt
Next
End Sub
</SCRIPT>
</head>
<body>
<select id=extension size="1" name="OptionChooser" onChange="TestSub">
<option value="0">Selet File Type</option>
<option value="1">.txt</option>
<option value="2">.pdf</option>
<option value="3">.jpg</option>
<option value="4">.mp3</option>
</select>
<select id=year size="1" name="OptionChooser1" onChange="TestSub1">
<option value="0">Select Year</option>
<option value="1">2014</option>
<option value="2">2013</option>
<option value="3">2012</option>
<option value="3">2011</option>
<option value="3">2010</option>
</select>
<select id=month size="1" name="OptionChooser2" onChange="TestSub2">
<option value="0">Select Month</option>
<option value="1">01</option>
<option value="2">02</option>
<option value="3">03</option>
<option value="1">04</option>
<option value="2">05</option>
<option value="3">06</option>
<option value="1">07</option>
<option value="2">08</option>
<option value="3">09</option>
<option value="1">10</option>
<option value="2">11</option>
<option value="3">12</option>
</select>
<input Type = "button" Value = "Browse For Folder"
Name = "Run_Button" onClick = "whichFolder"><p>
<input type="button" value="Search" name="RunSearch"><p>
<div id="DataArea" name="DataArea"></div>
</body>
</html>
Set IE = CreateObject("internetexplorer.Application")
IE.Visible = 1
IE.navigate "https://dashboard.opendns.com/settings/"
Do While (IE.Busy)
WScript.Sleep 10
Loop
Set Helem = IE.document.getElementByID("username")
Helem.Value = " "
Set Helem = IE.document.getElementByID("password")
Helem.Value = " "
IE.Application.document.getElementById("sign-in").Click
WScript.Sleep 10
<a id="dip22332965" title="Update this text" href="#"
onclick="update_ip(22332965);return false" img width="11" height="13"
style="border: 0pt none; margin-bottom: 1px;"
src="https://d2v7u03x06aro3.cloudfront.net/img/icon_update_small.gif">
I successfully sign in after clicking the button, but how can I click on image automatically as mentioned above script?
I have a HTA file that open a text box alows user to enter path to a folder then save it to a text file.
But when I trying to use second button to run a batch, it gives me an error code
Code Error 800A01A8 - Object Required : Wscript
<html>
<head>
<title>Files Sync </title>
<HTA:APPLICATION
APPLICATIONNAME="Files Sync"
ID="RY"
VERSION="1.0"/>
</head>
<script language="vbscript">
Sub WriteTxt_OnClick()
Dim fso, txt
Set fso = CreateObject("Scripting.FileSystemObject")
Set txt = fso.CreateTextFile("\\fs-02\C$\ntfs3\scripts\MexSync\000.txt")
txt.WriteLine document.Submitted_Link_To_Mex.body.value
MsgBox "File Submitted",64,"Selection"
End Sub
Sub SYNC_onClick()
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "cmd.exe /c C:\work\RLTP_SYNC_MEX\RunChangePS1.bat", 0
' 0 => hide
MsgBox("Success")
End Sub
</script>
<H2>Copy And Paste The Folder Path To Here </H2>
<body>
<form name="Submitted_Link_To_Mex">
<textarea name="body" cols="150" rows="20">
</textarea>
</form>
<br>
<input type="button" value="1. SUBMIT" name="WriteTxt">
<input type="Button" value="2. SYNC" name="SYNC">
<input type="Button" value="3. CLOSE" name="button2" onClick="close" class="button">
</div>
</body>
</html>
I can't find out why....did some research but no luck at all
Any suggestion?
The WScript object your line
Set WshShell = WScript.CreateObject("WScript.Shell")
tries to use does not exist in a HTA (it is provided by the w|cscript.exe hosts). As VBScript (the language itself) provides its own CreateObject function, just use
Set WshShell = CreateObject("WScript.Shell")
You need a trailing \ on your replacement text else you have DataAppData
Replace(txt, "K:\", "D:\Data\")
Also response.write is for ASP ...