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
Related
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 am trying to login to a website using the following which works on different url
Sub Mylogin()
Dim MyHTML_Element As IHTMLElement
Dim MyURL As String
On Error GoTo Err_Clear
MyURL = "MYURL"
ie.Silent = True
ie.Navigate MyURL
ie.Visible = True
Do
Loop Until ie.ReadyState = READYSTATE_COMPLETE
Set HTMLDoc1 = ie.Document
HTMLDoc1.all.Email.Value = "MYEMAIL" 'Enter your email id here
HTMLDoc1.all.Password.Value = "MYPASSWD" 'Enter your password here
For Each MyHTML_Element In HTMLDoc1.getElementsByTagName("input")
If MyHTML_Element.Type = "submit" Then MyHTML_Element.Click: Exit For
Next
Err_Clear:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub
The submit button is under div and I dont know if this is the problem. The html login part is the following
<div id="login-area-main">
<div id="user">
<div id="username">
<input name="p$lt$ctl01$LogonFormIndice$loginElem$UserName" type="text" maxlength="50" id="p_lt_ctl01_LogonFormIndice_loginElem_UserName" placeholder="E-mail" />
<span class="CMSValidator"><span id="p_lt_ctl01_LogonFormIndice_loginElem_rfvUserNameRequired" title="Please enter a user name." class="profile-validator validator error-message" style="display:none;">
</span></span>
</div>
</div>
<div id="pass">
<div id="password">
<input name="p$lt$ctl01$LogonFormIndice$loginElem$Password" type="password" maxlength="20" id="p_lt_ctl01_LogonFormIndice_loginElem_Password" placeholder="Password" />
<span class="CMSValidator"><span id="p_lt_ctl01_LogonFormIndice_loginElem_rfvPasswordRequired" class="profile-validator validator error-message" style="visibility:hidden;">
</span></span>
</div>
</div>
<div id="pass-forgot">
<p>Forgot Password</p>
</div>
<div id="submit-button">
<a id="p_lt_ctl01_LogonFormIndice_loginElem_btnLogon" class="buyBtn button" href="javascript:WebForm_DoPostBackWithOptions(new WebForm_PostBackOptions("p$lt$ctl01$LogonFormIndice$loginElem$btnLogon", "", true, "p_lt_ctl01_LogonFormIndice_MiniLogon", "", false, true))"></a>
</div>
Do I have to do something with
MyHTML_Element.Type = "submit"
And put inside the div id?
I notice that the HTMLDoc1 is Empty..! should it be empty?
I tried the following but nothing displayed or clicked
Const Url$ = "URL"
Dim UserName As String, Password As String, LoginData As Worksheet
Set LoginData = ThisWorkbook.Worksheets("MySheet")
UserName = LoginData.Cells(1, "K").Value
Password = LoginData.Cells(2, "K").Value
Dim iex As Object
Set iex = CreateObject("InternetExplorer.Application")
With iex
.Navigate Url
ieBusy iex
.Visible = True
Dim oLogin As Object, oPassword As Object
iex.Document.querySelector(".username [id='p_lt_ctl01_LogonFormIndice_loginElem_UserName']").Focus
Set oLogin = iex.Document.querySelector(".username [id='p_lt_ctl01_LogonFormIndice_loginElem_UserName']").Value = ""
Set oPassword = iex.Document.querySelector(".password [type=password]").Value = ""
oLogin.Value = UserName
oPassword.Value = Password
iex.Document.getElementById("submit-button").Click
End With
It asks about an Object on
iex.Document.querySelector("id='p_lt_ctl01_LogonFormIndice_loginElem_UserName']").Focus
I am confused by where your actual problem is.
There is an id for the submit
ie.document.getElementById("submit-button").click ' 0r .submit
For username:
ie.document.querySelector("[id='p_lt_ctl01_LogonFormIndice_loginElem_UserName']").value = ""
For password
ie.document.querySelector("[type=password]").value = ""
When entering values it sometimes helps to use .Focus on the element before assigning the .value.
Public Sub GetInfo()
Dim ie As New InternetExplorer
With ie
.Visible = True
.navigate URL
While .Busy Or .readyState < 4: DoEvents: Wend
With .document.querySelector("[id='p_lt_ctl01_LogonFormIndice_loginElem_UserName']")
.Focus
.value = ""
End With
With .document.querySelector("[type=password]")
.Focus
.value = ""
End With
.document.getElementById("submit-button").click
While .Busy Or .readyState < 4: DoEvents: Wend
Stop
'Quit
End With
End Sub
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 am working on project to download the dump from website and save it on the path specified using Excel vba.
Code is working perfectly when u do the debug or execute line by line by pressing "F8".
but when you execute the whole program by pressing "F5" or clicking on button after assigning macro to it. its not working.
need your precious advise to resolve this issue.
Thanks in Advance,
Prasanna
VBA Code used to login.
Sub Login()
Dim MyHTML_Element As IHTMLElement
Dim MyURL As String
Dim HTMLDoc As HTMLDocument
Dim MyBrowser As InternetExplorer
MyURL = "URL"
Set MyBrowser = New InternetExplorer
MyBrowser.Silent = True
MyBrowser.Navigate MyURL
MyBrowser.Visible = True
Do
Application.Wait DateAdd("s", 5, Now)
Loop Until MyBrowser.READYSTATE = READYSTATE_COMPLETE
Application.Wait DateAdd("s", 5, Now)
Set HTMLDoc = MyBrowser.document
HTMLDoc.all.Country_Code.Value = "Country_Code"
HTMLDoc.all.Login.Value = "UserName"
HTMLDoc.all.passwd.Value = "Password"
HTMLDoc.all.Item("B1").Click
For Each MyHTML_Element In HTMLDoc.getElementsByName("B1")
If MyHTML_Element.Type = "button" Then MyHTML_Element.Click: Exit For
Next
End sub
Sample HTML code of webpage for login.
<table border=0>
<tr>
<td>Country:</td>
<td>
<input type="text" name="country_code" maxlength=2
onblur="this.value=this.value.toUpperCase();Form1_action(this.value)">
</td>
</tr>
<tr>
<td>Language:</td>
<td>
<select name="idioma" disabled >
<option value="uk|es" onblur="document.Form1.login.focus()">ENGLISH</option>
<option value="sp|es" onblur="document.Form1.login.focus()">SPANISH</option>
<option value="fr|en-us" onblur="document.Form1.login.focus()">FRENCH</option>
<option value="it|en-us" onblur="document.Form1.login.focus()">ITALIAN</option>
<option value="de|de" onblur="document.Form1.login.focus()">GERMAN</option>
</select>
</td>
</tr>
<tr>
<td>Login:</td>
<td>
<input type="text" name="login" maxlength=10 value="" disabled >
</td>
</tr>
<tr>
<td>Password:</td>
<td>
<input type="password" autocomplete="off" name="passwd" maxlength=10 value="" disabled onkeypress="var okp=(event.which)?event.which:event.keyCode; if(okp==13) SiteRedirect(this.form)">
</td>
</tr>
</table>
<br>
<center>
<input type="button" name="B1" value="Sign In"
onclick="SiteRedirect()"
disabled
style="width:80pt"
>
</center>
This is the method I use to allow IE to load in an application that frequently works with webpages in IE. I have come to this after a lot of trial and error and it works consistently now - though I have seen many ways to accomplish this.
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
Sub IEWait(IE As Object)
'assumes IE is loaded as InternetExplorer.Application")
With IE
Do While .Busy Or .ReadyState <> 4: Sleep (100): Loop
End With
End Sub
You can add this to your code by
Placing the Public Declare at the top of your module window before any Sub are defined.
Incorporating it into your code as shown below.
Code:
With MyBrowser
.Silent = True
.Navigate MyURL
.Visible = True
Do While .Busy or .Readystate <> 4: Sleep (100): Loop
Set HTMLDoc = .document
'... rest of code
End With
Scott hit the nail on the head.
Sub Test()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.Navigate "http://www.marketwatch.com/investing/stock/aapl/analystestimates" ' should work for any URL
Do Until .ReadyState = 4: DoEvents: Loop
. . . YOUR CODE HERE . . .
End With
End Sub
OR
Sub DumpData()
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
URL = "http://finance.yahoo.com/q?s=sbux&ql=1"
'Wait for site to fully load
IE.Navigate2 URL
Do While IE.Busy = True
DoEvents
Loop
. . . YOUR CODE HERE . . .
End Sub
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>