I've written up a quick hta for quick actions via button: copy to clipboard, message boxes, and run specific files. Now I'm trying figure out how to add:
2 textarea boxes
TextArea1 - Type text inside
Submit button to save textarea1 to local file and load to textarea2
TextArea2 - will display text from saved local file from textarea1
Thanks for your time and consideration
<html>
<head>
<title>**All Access QL v1.0**</title>
<HTA:APPLICATION
ID="TestHTA"
APPLICATIONNAME="TestHTA"
ICON = "C:\L.S.L._QL_HTAv1.0\Media\RazerIcon.ico"
BORDER="thin"
MINIMIZEBUTTON="no"
MAXIMIZEBUTTON="no"
SCROLL="no"
SINGLEINSTANCE="no"
SysMenu="no"
WINDOWSTATE="normal">
<link rel="stylesheet" href="styles.css" media="all" type="text/css"/>
<SCRIPT LANGUAGE="VBScript">
Sub Window_onLoad
window.resizeTo 510,510
End Sub
Sub ExitProgram
window.close()
End Sub
Sub fileupdate
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFolder "C:\CopyFromLocation1","C:\CopyToLocation1", True
End Sub
Sub lotsiu
strMessage = "Line 1" & vbNewLine & "Line 2"
Set objWord = CreateObject("Word.Application")
With objWord
.Visible = False
.Documents.Add
.Selection.TypeText strMessage
.Selection.WholeStory
.Selection.Copy
.Quit False
End With
End Sub
Sub faqmbrPhonumuse
msgbox "Line 1" & vbNewLine & "Line 2"
End Sub
Sub appword
Set objShell = CreateObject("Wscript.Shell")
objShell.Run "WINWORD.exe"
End Sub
sub Window_onLoad()
set oFSO=CreateObject("Scripting.FileSystemObject")
set oFile=oFSO.OpenTextFile("Test.txt",1)
text=oFile.ReadAll
document.all.ScriptArea.value=text
oFile.Close
End sub
Sub Submitarea
Set oFile = fso.OpenTextFile( "TextArea.txt",8,true)
sTxtarea = document.all("Txtarea").Value
oFIle.Write sTxtarea & vbCRLF
MsgBox "Your text has been added to TextArea.txt", 64,"Textarea Input"
oFile.close
End Sub 'Submitarea
</SCRIPT>
</head>
<body>
<div id="Title">
<b>PSC Quick Access</b>
<input id="checkButton" class="upbutton" type="button" value="UPDATE" name="run_button" onClick="fileupdate" align="right">
<input id="checkButton" class="upbutton" type="button" value="EXIT" name="run_button" onClick="ExitProgram" align="right">
</div>
<div id="SubTitle">
Email- Phone Number
</div>
<div id="Icon">
</div>
<br>
<div id="ContentBox">
<b>Fax Temps (Click and Paste)</b>
</div>
<input id="checkButton" class="faxbutton" type="button" value="Button 1" name="btn_Next" onClick="button1" align="right">
<br>
<div id="ContentBox">
<b>Apps (Click To Start)</b>
</div>
<input id="checkButton" class="appbutton" type="button" value="Notepad" name="run_button" onclick="appnotepad" align="right">
<input id="checkButton" class="appbutton" type="button" value="Word" name="run_button" onClick="appword" align="right">
<br>
<div id="ContentBox">
<b>FAQs (Click for Info)</b>
</div>
<input id="checkButton" class="faqbutton" type="button" value="Num For Mbr" name="run_button" onClick="faqmbrPhonumuse" align="right">
<br>
<div id="ContentBox">
<b>Lotus Temps (Click and Paste)</b>
</div>
<input id="checkButton" class="lotbutton" type="button" value="SIU" name="btn_Next" onClick="lotsiu" align="right">
</div>
<form method="POST">
<TEXTAREA style="
Height:193;
Width:100%;
font-Size:12;
color:#000000;
background-color:#ffffe7;
font-weight:normal;
font-family:MS Sans Serif"
TITLE=""
NAME=Txtarea TABORDER=2 WRAP=PHYSICAL>The contents of this text area will be written to C:\TextArea.doc when you click submit.******First time submit is click if file has not been created it will be create automatically daily log with system date appended at the end******and will append data to top of file with prefix of system time******Line at end of margin will have hard return when text is at the end******And get and display new changed text in the lower text box and diplayed******Lower textarea has scroll and can be highlighted, but not editable"</TEXTAREA>
<input type="button" value="Submit" onclick="Submitarea">
<input type="reset" value="Clear">
<br><br>
<textarea name="ScriptArea" rows=10 cols=70></textarea><p>
</div>
</body>
EDIT : 09/03/2015 Try something like that :
<html>
<Title>How to open and read the log file with HTA</Title>
<head>
<HTA:APPLICATION
ICON="cmd.exe"
APPLICATIONNAME = "How to open and read the log file with HTA"
BORDER="dialog"
BORDERSTYLE="complex"
WINDOWSTATE="maximize"
>
<style>
body{
background-color: Black;
}
</style>
</head>
<script type="text/Vbscript">
Option Explicit
Dim File,fso,oFile,objShell
Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
File = "C:\Test_" _
& Month(Date) & "_" & Day(Date) & "_" & Year(Date) _
& ".txt"
'***********************************************************
Sub LoadMyFile()
txtBody.Value = LoadFile(File)
End Sub
'***********************************************************
Function LoadFile(File)
On Error Resume Next
Dim fso,F,ReadMe,strError
Set fso = CreateObject("Scripting.FileSystemObject")
Set F = fso.OpenTextFile(File,1)
If Err.Number <> 0 Then
strError = "<center><b><font color=Red>The file "& File &" dosen't exists !</font></b></center>"
myDiv.InnerHTML = strError
Exit Function
End If
ReadMe = F.ReadAll
LoadFile = ReadMe
End Function
'***********************************************************
Sub Clear()
txtBody.Value = ""
myDiv.InnerHTML = ""
Txtarea.Value = ""
End Sub
'***********************************************************
Function LogOpen()
Dim Ws,iReturn,strError
Set ws = CreateObject("WScript.Shell")
On Error Resume Next
iReturn = Ws.Run(File,1,False)
If Err.Number <> 0 Then
strError = "<center><b><font color=Red>The file "& File &" dosen't exists !</font></b></center>"
myDiv.InnerHTML = strError
Exit Function
End If
End Function
'***********************************************************
Sub Submitarea()
Dim oFile,sTxtarea,Readfile,ReadAllTextFile,strError
If Not fso.FileExists(File) Then
Set oFile = fso.OpenTextFile(File,2,true)
oFIle.write "The File "& File &" is created at " & FormatDateTime(now,vbLongTime)
oFile.Close
End If
Set Readfile = fso.OpenTextFile(File,1)
ReadAllTextFile = Readfile.ReadAll
Set oFile = fso.OpenTextFile(File,2,true)
sTxtarea = document.all("Txtarea").Value
oFIle.Writeline
oFIle.write ("Name ")
oFIle.write FormatDateTime(now, 2)
oFIle.write (" ")
oFIle.write FormatDateTime(now,vbLongTime)
'FormatDateTime(now, 4)
oFIle.write (" - ")
oFIle.Write sTxtarea & vbCrLf
oFIle.WriteLine ReadAllTextFile
myDiv.InnerHTML = "Your text has been added to "& File &""
oFile.Close
Call LoadMyFile()
End Sub
'***********************************************************
</script>
<body text="white">
<center><input type="button" name="Log" id="Start" value=" Load LogFile " onclick="LoadMyFile()"><br><br>
<textarea id="txtBody" rows="15" cols="120"></textarea><br><br>
<input type="button" name="Log" id="Start" value=" Open LogFile with Notepad " onclick="LogOpen()">
<input type="button" value=" Clear " onclick="Clear()"></center>
<Div id="myDiv"></Div>
<br><br>
<TEXTAREA style="
Height:193;
Width:100%;
font-Size:12;
color:#000000;
background-color:#ffffe7;
font-weight:normal;
font-family:MS Sans Serif"
TITLE=""
ID="Txtarea" NAME="Txtarea" TABORDER="2" WRAP="PHYSICAL">The contents of this text area will be written to TextArea.txt when you click submit.</TEXTAREA><br><br>
<center><input type="button" value="Submit" onclick="Submitarea">
<input type="reset" value="Reset"></center>
</body>
</html>
Related
Having problems! I have messed with this code over and over. This is just one of my attempts. Trying to add a record to a database and upload an image at the same time. The first one I sent would add the record but, would not upload the image. This one will upload the image but, will not add the record. My patience is running out. On this one I'm getting a error saying I can't use generic requests.
<%# Language=VBScript %>
<%
option explicit
Response.Expires = -1
Server.ScriptTimeout = 600
Session.CodePage = 65001
dim uid,thisuid,bizid,sourceid,email,PTitle,uname,conn,ucomments,RelatedTo,ToMessage,imgid,sql
uid = "JIU645OIuoiUI6435OIUhouihoHI"
%>
<!-- #include file="freeaspupload.asp" -->
<%
Dim uploadsDirVar
uploadsDirVar = "c:\inetpub\wwwroot\the-website\users\" & uid & "\"
function OutputForm()
%>
<div class="w3-card w3-round w3-white">
<div class="w3-container">
<h6 class="w3-opacity">Create A Post</h6>
<form method="POST" enctype="multipart/form-data" accept-charset="utf-8" action="uploadTester.asp" onSubmit="return onSubmitForm();">
<input name="UComments" type="text" style="padding:5px;width:100%;" placeholder="Type your comments..." required>
<br><br>
<button type="submit" class="w3-btn w3-theme" value="Upload"><i class="fa fa-pencil"></i> Post</button>
<div class="photodiv w3-btn w3-theme"><i class="fa fa-image"></i> Photo<input type="file" name="attach1" class="hide_file"></button></div>
<input hidden name="sourceid" value="<%= sourceid %>">
<input hidden name="uid" value="<%= uid %>">
<input type="hidden" name="NewMess" size="20" value="Yes">
<input type="hidden" name="RelatedTo" size="20" value="0">
<input type="hidden" name="Email" value="<%= email %>">
<input type="hidden" name="TableName" value="ProWall">
<input type="hidden" name="Title" value="<%= PTitle %>">
<input type="hidden" name="ThisMessage" size="20" value="0">
<input type="hidden" name="Name" value="<%= uname %>">
</form>
</div><div> </div>
</div>
<%
end function
function TestEnvironment()
Dim fso, fileName, testFile, streamTest
TestEnvironment = ""
Set fso = Server.CreateObject("Scripting.FileSystemObject")
if not fso.FolderExists(uploadsDirVar) then
TestEnvironment = "<B>Folder " & uploadsDirVar & " does not exist.</B><br>The value of your uploadsDirVar is incorrect. Open uploadTester.asp in an editor and change the value of uploadsDirVar to the pathname of a directory with write permissions."
exit function
end if
fileName = uploadsDirVar & "\test.txt"
on error resume next
Set testFile = fso.CreateTextFile(fileName, true)
If Err.Number<>0 then
TestEnvironment = "<B>Folder " & uploadsDirVar & " does not have write permissions.</B><br>The value of your uploadsDirVar is incorrect. Open uploadTester.asp in an editor and change the value of uploadsDirVar to the pathname of a directory with write permissions."
exit function
end if
Err.Clear
testFile.Close
fso.DeleteFile(fileName)
If Err.Number<>0 then
TestEnvironment = "<B>Folder " & uploadsDirVar & " does not have delete permissions</B>, although it does have write permissions.<br>Change the permissions for IUSR_<I>computername</I> on this folder."
exit function
end if
Err.Clear
Set streamTest = Server.CreateObject("ADODB.Stream")
If Err.Number<>0 then
TestEnvironment = "<B>The ADODB object <I>Stream</I> is not available in your server.</B><br>Check the Requirements page for information about upgrading your ADODB libraries."
exit function
end if
Set streamTest = Nothing
end function
function SaveFiles
Dim Upload, fileName, fileSize, ks, i, fileKey, filedname
Set Upload = New FreeASPUpload
Upload.Save(uploadsDirVar)
filedname = 1
for each fileKey in Upload.UploadedFiles.keys
if filedname = 1 then
filedname = filedname + 1
imgid = Upload.UploadedFiles(fileKey).FileName
end if
next
uid=Upload.Form("uid")
thisuid=Upload.Form("thisuid")
email=Upload.Form("email")
ucomments=Upload.Form("ucomments")
RelatedTo=Upload.Form("RelatedTo")
ToMessage=Upload.Form("ToMessage")
if ToMessage = "" then
ToMessage = 0
end if
if RelatedTo = "" then
RelatedTo = 0
End if
set conn=Server.CreateObject("ADODB.Connection")
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; DATA SOURCE=c:/inetpub/wwwroot/the-website/contents/page/MBoard.mdb"
sql="INSERT INTO ProWall (uid,sourceid,email,ucomments,posted,RelatedTo,ToMessage,imgid) VALUES ('"&uid&"','"&thisuid&"','"&email&"','"&ucomments&"','"&Now&"','"&RelatedTo&"','"&ToMessage&"','"&imgid&"';"
Set rs= Server.CreateObject("ADODB.Recordset")
rs.Open sql, conn, 3, 2
conn.close
set conn = nothing
'response.redirect "show-msg.asp"
' If something fails inside the script, but the exception is handled
If Err.Number<>0 then Exit function
end function
%>
<HTML>
<HEAD>
<TITLE>Test Free ASP Upload 2.0</TITLE>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<style>
BODY {background-color: white;font-family:arial; font-size:12}
</style>
<script>
function onSubmitForm() {
var formDOMObj = document.frmSend;
if (formDOMObj.attach1.value == "" && formDOMObj.attach2.value == "" && formDOMObj.attach3.value == "" && formDOMObj.attach4.value == "" )
alert("Please press the Browse button and pick a file.")
else
return true;
return false;
}
</script>
</HEAD>
<link rel="stylesheet" href="https://www.w3schools.com/w3css/4/w3.css">
<link rel="stylesheet" href="https://www.w3schools.com/lib/w3-theme-blue-grey.css">
<link rel='stylesheet' href='https://fonts.googleapis.com/css?family=Open+Sans'>
<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/4.7.0/css/font-awesome.min.css">
<style>
html, body, h1, h2, h3, h4, h5 {font-family: Open Sans, sans-serif;}
.photodiv{
padding:8px 16px;
background:;
border:0px;
position:relative;
color:#fff;
border-radius:2px;
text-align:center;
float:left;
cursor:pointer
}
.hide_file {
position: absolute;
z-index: 1000;
opacity: 0;
cursor: pointer;
right: 0;
top: 0;
height: 100%;
font-size: 24px;
width: 100%;
}
</style>
<BODY onload="OutputForm()">
<%
Dim diagnostics
if Request.ServerVariables("REQUEST_METHOD") <> "POST" then
diagnostics = TestEnvironment()
if diagnostics<>"" then
response.write "<div style=""margin-left:20; margin-top:30; margin-right:30; margin-bottom:30;"">"
response.write diagnostics
response.write "<p>After you correct this problem, reload the page."
response.write "</div>"
else
response.write "<div style=""margin-left:150"">"
OutputForm()
response.write "</div>"
end if
else
response.write "<div style=""margin-left:150"">"
OutputForm()
response.write SaveFiles()
response.write "<br><br></div>"
end if
%>
</BODY>
</HTML>
Hi i'm trying to get the "Create an Issue" button to click after filling out a form online. The form fills correctly I just need it to do the final piece and click on the "Create Issue".
Here's my setup and code
Microsoft Excel 2016 32bit
VBA:
Option Explicit
Sub Waiting()
Application.Wait (Now + TimeValue("0:00:2"))
End Sub
Sub IE_Wait(IE As InternetExplorer)
With IE
While .Busy Or .ReadyState <> READYSTATE_COMPLETE
DoEvents
Call Waiting
' SendKeys "{ENTER}"
Wend
While .Document.ReadyState <> "complete"
DoEvents
Call Waiting
'SendKeys "{ENTER}"
Wend
End With
End Sub
Sub FindAndTerminate(ByVal strProcName As String)
Dim objWMIService, objProcess, colProcess
Dim strComputer, strList
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
Set colProcess = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = '" & strProcName & "'")
If colProcess.Count > 0 Then
For Each objProcess In colProcess
On Error Resume Next
objProcess.Terminate
Next objProcess
End If
End Sub
Public Sub make_tickets_with_me()
Dim IE As InternetExplorer
Dim HTMLdoc As HTMLDocument
Dim x, Site, ASIN_1, ASIN_2, ASIN_3, ASIN_4, ASIN_5 As String
Dim ws As Worksheet
Dim e
Dim y, lLastRow As Long
' Kill any currently running Explorer Windows
FindAndTerminate "iexplore.exe"
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
Set IE = New InternetExplorerMedium
With ThisWorkbook
lLastRow = Worksheets("ASINs").Cells(Rows.Count, "A").End(xlUp).Row 'Count total Asins
x = 2
For x = 2 To lLastRow
Debug.Print x
ASIN_1 = Worksheets("ASINs").Range("A" & x).Value
ASIN_2 = Worksheets("ASINs").Range("A" & x + 1).Value
ASIN_3 = Worksheets("ASINs").Range("A" & x + 2).Value
ASIN_4 = Worksheets("ASINs").Range("A" & x + 3).Value
ASIN_5 = Worksheets("ASINs").Range("A" & x + 4).Value
Site = "https://sim.amazon.com/issues/create?assignedFolder=5aec25c2-1135-4d36-b751-37d967c0a83e&title=Zappos+Unsellable+Test&description=Below+is+a+list+of+5+asins+that+are+unsellable%3A%20%0D%0A%0D%0A" + ASIN_1 + "%0D%0A" + ASIN_2 + "%0D%0A" + ASIN_3 + "%0D%0A" + ASIN_4 + "%0D%0A" + ASIN_5 + "%0D%0A%0D%0A&descriptionContentType=text%2Fplain&extensions%5Btt%5D%5Bimpact%5D=4&extensions%5Btt%5D%5Bcategory%5D=&authorizations%5B%5D=BREAK&authZCompression=v1"
x = x + 4
' Debug.Print ASIN_1 & ASIN_2 & ASIN_3 & ASIN_4 & ASIN_5
' Debug.Print x
' Debug.Print Site
''' BEGIN INTERACTION WITH IE
Set IE = New InternetExplorerMedium
With IE
.Visible = True
.Left = 25
.Top = 25
.Height = 700
.Width = 1300
AppActivate ("Internet Explorer")
.Navigate Site
IE_Wait IE
Call Waiting
IE_Wait IE
Call Waiting
Set e = IE.Document.getElementsByTagName("span")
->>>>>>>If e.innerText = "Create an issue In Zappos Unsellable: Tickets" Then
e.parentElement.Click
Exit For
End If
'Set e = IE.Document.getElementsByClassName("create")(0)
'e.Click
' SendKeys "{NUMLOCK}"
Call Waiting
.Quit
End With
Next 'Loop for x=2 to lLastRow, Adds 4 to x, then Next adds 1 to total of 5 per iteration
ThisWorkbook.Worksheets("Buttons").Activate
MsgBox ("Tickets Created :)")
End With
End Sub
I've added an arrow to where the error is.
Here's the Inspect for the button I want to click
</div>
<div class="clearfix"></div>
<script type="jsv/50_"></script></div></section>
<section class="wizard-step " id="wizard-step-2" data-wizard-step="2"><div data-module-name="App.Views.CreateWizardStep" data-template="#create-wizard-step-template"><script type="jsv#112_"></script>
<div class="form-actions">
<div class="view-state-initialized-visible" data-view="create">
<button class="btn btn-primary btn-large" type="submit" data-csm-counter="createViewCreateButton">
<span style="display: inline;" data-link="visible{:!~isUndefined(issue.assignedFolder)}"><span id="view-tag-157" data-module-name="App.Views.FolderDisplayView" data-template="undefined"><script type="jsv#170_"></script><span style="display: inline;" data-name="folder-label-completed-text" data-link="visible{:state == 'completed'}">
<script type="jsv#219^"></script><script type="jsv#308_"></script>
<script type="jsv#388^"></script>Zappos Unsellable: Tickets
Create an issue in
<script type="jsv/388^"></script>
<script type="jsv/308_"></script><script type="jsv/219^"></script>
</span><span style="display: none;" data-link="visible{:state == 'loading'}">
<script type="jsv#172_"></script><i class="icon-spinner"></i><script type="jsv/172_"></script>
Loading folder...
</span><span style="display: none;" data-link="visible{:state == 'errored'}">
Could not find folder
</span><span style="display: none;" data-link="visible{:state == 'empty'}">
Folder not specified
</span><script type="jsv/170_"></script></span>
</span>
<span style="display: none;" data-link="visible{:~isUndefined(issue.assignedFolder)}">
Create an issue
</span>
</button>
<div class="alert alert-error pull-right" style="display: none;" data-link="visible{:!state.isValid}">
Please correct the errors above
</div>
</div>
<div class="view-state-loading-visible alert alert-info" data-view="create">
<script type="jsv#113_"></script><i class="icon-spinner"></i><script type="jsv/113_"></script>
Creating your issue...
</div>
<div class="view-state-errored-visible alert alert-error" data-view="create">
<strong>There was an error creating your issue:</strong>
<div data-link="html{>state.createError}"></div>
<button class="btn btn-primary pull-right" type="submit" data-csm-counter="createViewTryAgainButton">
Try again
</button>
<div class="clearfix"></div>
</div>
<div class="view-state-redirecting-visible alert alert-success" data-view="create">
Redirecting you to
<a href="/issues/undefined" data-link="href{:'/issues/' + issue.id} data-issue-id{htmlAttr:issue.id}" data-issue-id="">
your new issue
</a>
</div>enter code here
Any help would be appreciated i'm trying to edit another persons VBA that left.
You can try a combination of css selectors
ie.document.querySelector("button[data-csm-counter=createViewTryAgainButton]").click
I need to access this website, click in "Entrar" and then interact with the popup (that is an iframe).
And, using the URL of the iframe is not an option.
My code:
Dim ie As SHDocVw.InternetExplorer
Dim doc As MSHTML.HTMLDocument
Dim url As String
url = "https://agenciavirtual.light.com.br/AGV/"
Set ie = New SHDocVw.InternetExplorer
ie.Visible = True
ie.Navigate url
While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
DoEvents
Wend
Set doc = ie.Document
Dim iframeDoc As MSHTML.HTMLDocument
Set iframeDoc = doc.Frames(0).Document
If iframeDoc Is Nothing Then
MsgBox "IFrame was not found."
ie.Quit
Exit Sub
End If
iframeDoc.getElementsByTagName("input")(0).innertext = "123"
iframeDoc.getElementsByTagName("input")(1).innertext = "1234567890"
iframeDoc.getElementsByTagName("button")(0).Click
ie.Quit
The following line generates the error "Acess is denied"
iframeDoc = doc.Frames(0).Document
I've tried other ways like
'Generates the error "Automation Error"
IE.Document.getElementsbyTagName("iframe")(0).contentDocument.getElementsbyTagName("input")(0).innerText = "123"
'Generates the error "Method 'frames' of object 'JScriptTypeInfo' failed"
IE.Document.Frames(0).Document.forms(0).innerText
Main page HTML
<html>
<head>...</head>
<body>
<iframe class="suaIframe" src="https://suav2.light.com.br/Home/Login?DominioCanal=https://agenciavirtual.light.com.br/AGV&PlataformaVersao=Z52&ReturnUrl=/AGV/Autenticacao/LoginSUA&Servico=8&fullScreen=false"></iframe>
</body>
</html>
Iframe HTML
<html>
<head>...</head>
<body>
...
<input class="itemForm" id="CPFCNPJ" maxlength="3" name="CPFCNPJ" onkeypress="return onlyNumbers(this, event);" placeholder="Preencha somente com os 3 primeiros dígitos" type="tel" value="">
<input class="itemForm" id="PN" maxlength="10" name="PN" onkeypress="return onlyNumbers(this, event);" placeholder="Informe o código do cliente" type="tel" value="">
<button type="button" name="btnEntrar" id="btnEntrar" class="btn btn-primary btn-entrar" value="entrar">Entrar</button>
...
</body>
</html>
I design ".html" file that takes inputs from the user and returns some outputs.
The inputs are Query sequence and Name of database.
I want to put the query sequence in a txt file and execute the local program "cmd application" by type:
blastn -query querySequence.txt -db databaseName -out outputFile.txt
Then, present the output file to the user.
I am using windows 7. I think perl is a solution but I did not know anything about perl and how it is working!
Screenshot of CommandLine.hta
So, just copy and paste this code on your notepad or notepad++ and save it as CommandLine.hta and execute it by double clic.
NB : The extension must be .hta and not .html
<html>
<title>Execution of command line with HTA by Hackoo</title>
<head>
<HTA:APPLICATION
APPLICATIONNAME="Execution of command line with HTA by Hackoo"
SCROLL="no"
SINGLEINSTANCE="yes"
WINDOWSTATE="maximize"
ICON="Winver.exe"
/>
</head>
<META HTTP-EQUIV="MSThemeCompatible" CONTENT="YES">
<script language="VBScript">
Option Explicit
Dim Title : Title = "Execution of command line with HTA by Hackoo"
'**********************************************************************************************
Sub Window_OnLoad
Call Run_Cmd("help")
End Sub
'**********************************************************************************************
Sub Run_Cmd(strCommand)
On Error Resume Next
If input.value = "" Then
MsgBox "ATTENTION ! The text box is empty !"& vbcr &_
"You forgot to type a command on the text box !",vbExclamation,Title
input.value = "help"
Exit Sub
End if
Output.value = ""
btnClick.disabled = True
document.body.style.cursor = "wait"
btnClick.style.cursor = "wait"
Const ForReading = 1
Const TristateTrue = -1
Const TemporaryFolder = 2
Const WshHide = 0
Dim wsh, fs, ts
Dim strTempFile,strFile, strData
Set wsh = CreateObject("Wscript.Shell")
Set fs = CreateObject("Scripting.FileSystemObject")
strTempFile = fs.BuildPath(fs.GetSpecialFolder(TemporaryFolder).Path, fs.GetTempName)
strFile = fs.BuildPath(fs.GetSpecialFolder(TemporaryFolder).Path, "result.txt")
wsh.Run "cmd.exe /c " & strCommand & " > " & DblQuote(strTempFile) & "2>&1", WshHide, True
wsh.Run "cmd.exe /u /c Type " & DblQuote(strTempFile) & " > " & DblQuote(strFile) & "", WshHide, True
Set ts = fs.OpenTextFile(strFile,ForReading,True,TristateTrue)
strData = ts.ReadAll
Output.Value = "Microsoft Windows [version 7.1 7631]" & vbcrlf &_
"Copyright (c) 2009 Microsoft Corporation. All rights reserved." & vbcrlf & vbcrlf &_
"C:\>"& strCommand & vbcrlf & strData
ts.Close
fs.DeleteFile strTempFile
fs.DeleteFile strFile
document.body.style.cursor = "default"
btnClick.style.cursor = "default"
btnClick.disabled = False
End Sub
'**********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
Sub OnClickButtonCopy()
document.parentwindow.clipboardData.SetData "text", Output.Value
MsgBox "The ouput result is copied to the clipboard !",vbInformation,Title
End Sub
'**********************************************************************************************
</script>
</head>
<body bgcolor="123456" text=Darkorange>
<hr>
<center><FONT SIZE="3"><B><I>Some examples of commands</I></B></FONT><BR>
<select style="background-color:lightblue" name="DropDown">
<option value="Tasklist">Tasklist</option>
<option value="CD %Programfiles%\Mozilla Firefox\ | Start Firefox.exe">CD %Programfiles%\Mozilla Firefox\ | Start Firefox.exe</option>
<option value="Tracert www.google.fr">Tracert www.google.fr</option>
<option value="Start iexplore">Start iexplore</option>
<option value="Start Notepad">Start Notepad</option>
<option value="Start Winword">Start Winword</option>
<option value="Explorer.exe /n,/e,/root,C:\Program Files">Explorer.exe /n,/e,/root,C:\Program Files</option>
<option value="Ipconfig">IpConfig</option>
<option value="Dir">Dir</option>
<option value="Ping www.yahoo.fr">Ping www.yahoo.fr</option>
<option value="Ping www.google.fr">Ping www.google.fr</option>
<option value="Taskkill /im iexplore.exe /f">Taskkill /im iexplore.exe /f</option>
</select>
<input type="button" onClick="Run_Cmd(DropDown.value)" value="Run this command">
<center><hr><B><I>Type your input command here</I></B><br>
<input type="text" Name="input" size="10"style="width:100%" value="Ping www.google.com" style="background-color:lightblue">
<input type="submit" name="btnClick" value="Run the input command line" onclick="Run_Cmd(input.value)">
<br><hr><B><I> The output result (readonly)</I></B><hr>
<textarea readonly id="Output" style="width:100%" rows="28" style="background-color:black; color:Darkorange">Microsoft Windows [version 7.1 7631]
Copyright (c) 2009 Microsoft Corporation. All rights reserved.
C:\></textarea><input type="button" name="ButtonCopy" value="Copy the ouput result to the Clipboard" onclick="OnClickButtonCopy">
<hr></center>
</body>
</html>
i have an html form with an vbscript wich saves the data in an excel-sheet. My problem is that 30 people will use the same html form, so it will happen that two or more will save at the same time.
My Idea is that the vbscript checks if the excel-file is open and when it is waits till it is closed, so it can open it again and save the data, but I have no Idea how to implent that in the code. I have only little knowledge in vbscript and most of my code is gathered through research.
Here is my code so far:
<HTML>
<HEAD><TITLE>Save in Excel</TITLE></HEAD>
<SCRIPT Language = "VBScript">
Function Export(A,B,C,D,E)
Set ExcelApp = CreateObject("Excel.application")
ExcelApp.Visible = True
strPathDoc = "G:\Test.xls"
Set myExcelDoc = ExcelApp.Workbooks.Open(strPathDoc)
ExcelApp.Visible = True
myExcelDoc.Windows(1).Visible = True
set XlSheet = myExcelDoc.Worksheets(1)
currentRow = 2
currentVal = XlSheet.Range("A" & currentRow).value
While currentVal <> ""
currentRow = currentRow + 1
currentVal = XlSheet.Range("A" & currentRow).value
Wend
XlSheet.Range("A" & currentRow).value = A
XlSheet.Range("B" & currentRow).value = B
XlSheet.Range("C" & currentRow).value = C
XlSheet.Range("D" & currentRow).value = D
XlSheet.Range("E" & currentRow).value = E
myExcelDoc.save
myExcelDoc.close
Set myExcelDoc = Nothing
Set ExcelApp = Nothing
End Function
Sub cmdExp_OnClick()
Dim lPrincipal
Dim dblRate
Frstnm = Disnm.value
Lstnm = TreatGrp.value
Mdlnm = TreatGrp2.value
Motnm = TreatGrp3.value
Fatnm = TreatGrp4.value
cInterest = Export(Frstnm, Lstnm, Mdlnm, Motnm, Fatnm)
End Sub
</SCRIPT>
<BODY>
<BR>
Test 1: <INPUT Type="Text" Name="Disnm" Value=""><BR>
Test 2: <INPUT Type="Text" Name="TreatGrp" Value=""><BR>
Test 3: <INPUT Type="Text" Name="TreatGrp2" Value=""><BR>
Test 4: <INPUT Type="Text" Name="TreatGrp3" Value=""><BR>
Test 5: <INPUT Type="Text" Name="TreatGrp4" Value=""><BR>
<INPUT Type="Button" Name="cmdExp" Value="Start">
</BODY>
</HTML>
Thanks in advance