HTA created table to Excel

X

Xlacs

Board Regular
Joined
Mar 31, 2021
Messages
105
Office Version
  1. 2016
Platform
  1. Windows
Hi Everyone,

Just want to seek guidance on the below code.
Basically, the tool will create a data in the table and submit it in an excel file.

Problem is, I'm not getting my desired result,

This is where the user fill up the required fill out the required fields.
1620190050566.png


Once submitted, data will be stored in the created table below.

1620190126925.png


And once user Click the add to XL button. All the data should be submitted in the Book1 Workbook.

1620190209741.png

But I'm only getting the name, grade, category, desc, and status. Not the data submitted on those fields.

Any idea?

<html>

<head>
<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
<title>XLS Data</title>
<script language="vbscript">
Sub AddRow()
Set objTable = document.getElementById("tbl1")
Set objRow = objTable.insertRow()
For intCount = 0 To 4
Set objCell = objRow.insertCell()
select case intCount
case "0"
objCell.innerHTML = document.getElementById("name").value
case "1"
objCell.innerHTML=document.getElementById("grade").value
case "2"
objCell.innerHTML = document.getElementById("company").value
case "3"
objCell.innerHTML = document.getElementById("desc").value
case "4"
objCell.innerHTML = document.getElementById("status").value
end select
Next

End Sub

Sub formReset()
document.getElementById("frm").reset()
End Sub
</script>

<script type="text/vbscript">

Sub Submit()
strFileName = "C:\Users\ChrisLacs\Desktop\Book2.xlsx"
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWorkbook = objExcel.Workbooks.Open(strFileName)
Set objWorksheet = objWorkbook.Worksheets(1)
Const xlCellTypeLastCell = 11
objWorksheet.UsedRange.SpecialCells(xlCellTypeLastCell).Activate

i = 1
For Each cell In tbl1.thead.rows(0).Cells
objWorksheet.Cells(1,i).Value = cell.innerText
i = i + 1

Next
End Sub






</script>

<hta:application
applicationname="XLS Data"
border="dialog"
borderstyle="normal"
caption="Test"
contextmenu="yes"
icon=""
maximizebutton="yes"
minimizebutton="yes"
navigable="no"
scroll="no"
selection="yes"
showintaskbar="yes"
singleinstance="yes"
sysmenu="yes"
version="1.0"
windowstate="normal"
>
<style type="text/css">
body
{
background-color: white;
overflow: auto;
color: #red;
}

textarea
{
overflow: auto;
}
</style>
</head>

<body>
<form id="frm">
<div align="center"><h1>Test</h1></div>
<p>Name: <input type="text" id="name" max="20" /></p>
<p>Grade: <select id="grade">
<option value="4">4</option>
<option value="3">3</option>
<option value="2">2</option>
<option value="1">1</option>
</select>
</p>
<p>Company: <input type="text" id="company" max="50" /></p>
<p>Description: <BR><TEXTAREA NAME="desc" ROWS=5 COLS=80>Employee Description</TEXTAREA></p>
<p>Status: <BR><TEXTAREA NAME="status" ROWS=5 COLS=80>Employee status</TEXTAREA></p>
<input type="button" onclick="formReset()" value="Reset form">
</form>
<br><input type="button" value="Add Row" onclick="AddRow()">
<input id=runbutton type="button" value="Add to XL" onClick="Submit">
<table id="tbl1" width="100%" border="1">
<thead>
<tr>
<th>Name</th>
<th>Grade</th>
<th>Company</th>
<th>Description</th>
<th>Status</th>
</tr>
</thead>
</table>
</form>
</body>
</html>
VBA Code:
 
Sort by date Sort by votes
Dan_W said:
Hi. I just checked the HTA file - I ran it four times. Each time I ran it, I made one or two entries, and I increased the grade by one. I would then save the workbook, close the workbook, close the HTA file, and then repeat. As you can see in the BB capture below, each entry followed the next in consecutive rows. Is that not what you wanted?

MrExcel.xlsm
ABCDE
1NameGradeStatusDescription Company
2Mr Excel1Mr Excel Pty LtdThis is a description of the employeePerson status
3Ms VBA1Mr Excel Pty LtdThis is a description of the employee, VBACode status
4Ms Python2ACompetitor Pty LtdThis is a description of the employee, Python, at another company.Code status
5Great Employee A3Bad CoHere is another employee descriptionNew status
6Great Employee B3Good CoHere is another employee descriptionNew status
7Terrible Employee C4Good CoHere is another employee descriptionOld status
Sheet1
Click to expand...
will try that code Dan.
 
Upvote 0

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Basically, below is my modified code. The only problem is when I submit data to excel..
The data is transferring not in the next available Blank cell but in the middle or sometimes worst.

I have applied your provided code but i'm not sure if applied it correctly since I modified it.
This is stressing me out already =[

Sorry for this.

VBA Code: 
<html>

<head>

<hta:application applicationname="XLS Data" border="dialog" borderstyle="normal" caption="Test" contextmenu="yes"
icon="" maximizebutton="yes" minimizebutton="yes" navigable="no" scroll="no" selection="yes" showintaskbar="yes"
singleinstances="yes" sysmenu="yes" version="1.0" windowstate="normal" SysMenu="no">

<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">

<title>XLS Data</title>

<script language="vbscript">


Sub AddRow()

If document.getElementById("name").value = "" Then
MsgBox "Missing Reference Number.",64, "Alert"
Exit Sub
End If

If document.getElementById("template").value = "" Then
MsgBox "Please indicate type of Case.",64, "Alert"
Exit Sub
End If


    set objTable = document.GetElementById("tbl1")
    set objRow = objTable.insertRow()

For intCount = 0 To 7
    set objCell = objRow.insertCell()
    Select Case intCount
  
    Case "0"
        objCell.innerHTML = document.GetElementById("clockbox").value
    Case "1"
        objCell.innerHTML = document.GetElementById("username").value
    Case "2"
        objCell.innerHTML = document.GetElementById("nim").value
    Case "3"
        objCell.innerHTML = document.GetElementById("tim").value
    Case "4"
        objCell.innerHTML = document.GetElementById("name").value
    Case "5"
        objCell.innerHTML = document.GetElementById("template").value
    Case "6"
        objCell.innerHTML = document.GetElementById("plat").value
    Case "7"
        objCell.innerHTML = document.GetElementById("adminmessage").value
  
  

    End Select
    Next


Document.getElementsByName    ("name")     (0).Value = ""
Document.getElementsByName    ("template")     (0).Value = ""
Document.getElementsByName    ("adminmessage") (0).Value = ""


End Sub

</script>

<script type="text/vbscript">

Sub AddXL()

    Dim intRow
    Dim intCol
    Dim blnHeaderRow
    strFileName = "C:\Users\43547826\Desktop\Daily Email  V2.xlsm"
    Set objExcel = CreateObject("Excel.Application")
    objExcel.visible = True
    Set objWorkbook = objExcel.Workbooks.Open(strFileName)
    Set objWorksheet = objWorkbook.Worksheets(1)
    Const xlCellTypeLastCell = 11



intRow = objWorksheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1


For Each tblRow in tbl1.Rows
If blnHeaderRow = True Then

    intCol = 1

For Each cell in tblRow.Cells
    objWorksheet.Cells(intRow, intCol).value = cell.InnerText
    intCol = intCol + 1

Next

intRow = intRow + 1

Else

blnHeaderRow = True

End If




  objWorksheet.Cells.WrapText = True
Location.reload()




Next
End Sub

</script>




<style type="text/css">

body {
background-color: lightgrey;
overflow: auto;
color: #red;
}

textarea {
overflow: auto;
}


.button {

background-color: green;
boarder: 2px green;
radius: 4px;
color: white;
padding: 6px 10px;
text-align: center;
text-decoration: none;
display: inline-block;
font-size: 12px;
font-weight: bold;
border-radius: 50%;
border-shadow:0 9px #999
}


</style>
</head>



<script type="text/javascript">


tmonth=new Array("January","February","March","April","May","June","July","August","September","October","November","December");

function GetClock(){
d = new Date();

nmonth = d.getMonth();
ndate  = d.getDate();

document.getElementById('clockbox').value=""+tmonth[nmonth]+" - "+ndate+"";
setTimeout("GetClock()", 1000);
}
window.onload=GetClock;

</script>




<script language="VBScript">

Dim WshNetwork
Set WshNetwork = CreateObject("Wscript.Network")



Sub Window_onLoad()

document.getElementById("username").value = WshNetwork.username

if document.getElementById("username").value = "43547826" Then

document.getElementById("nim").value = "Christopher Lacanaria"
document.getElementById("tim").value = "Manual Review" 

End If

if document.getElementById("username").value = "43785022" Then

document.getElementById("nim").value = "Diane Catherine Geronimo"
document.getElementById("tim").value = "Manual Review" 

End If


if document.getElementById("username").value = "43676783" Then

document.getElementById("nim").value = "Abad Glenda"
document.getElementById("tim").value = "Manual Review" 

End If


if document.getElementById("username").value = "43451426" Then

document.getElementById("nim").value = "Sapalicio, Celia"
document.getElementById("tim").value = "Manual Review" 

End If


if document.getElementById("username").value = "43791170" Then

document.getElementById("nim").value = "Flores Georgina "
document.getElementById("tim").value = "Manual Review" 

End If

if document.getElementById("username").value = "43354754" Then

document.getElementById("nim").value = "Morong Relyn"
document.getElementById("tim").value = "Manual Review" 

End If

if document.getElementById("username").value = "43791163" Then

document.getElementById("nim").value = "Estacio Madelle Mae"
document.getElementById("tim").value = "Manual Review" 

End If

if document.getElementById("username").value = "44103963" Then

document.getElementById("nim").value = "Aquino, Reymond "
document.getElementById("tim").value = "Manual Review" 

End If

if document.getElementById("username").value = "43547833" Then

document.getElementById("nim").value = "Lozendo Mervic "
document.getElementById("tim").value = "Manual Review" 

End If

if document.getElementById("username").value = "43318940" Then

document.getElementById("nim").value = "Zarzoso, Carol"
document.getElementById("tim").value = "Manual Review" 

End If

if document.getElementById("username").value = "44041710" Then

document.getElementById("nim").value = "Elinon Sharie Ann"
document.getElementById("tim").value = "Verification" 

End If

if document.getElementById("username").value = "44086782" Then

document.getElementById("nim").value = "Pe Benito Marc"
document.getElementById("tim").value = "Verification" 

End If

if document.getElementById("username").value = "43789682" Then

document.getElementById("nim").value = "Claravall, Angelo"
document.getElementById("tim").value = "Verification" 

End If


if document.getElementById("username").value = "45010913" Then

document.getElementById("nim").value = "Decierdo, Ryan"
document.getElementById("tim").value = "Verification" 

End If

if document.getElementById("username").value = "44103899" Then

document.getElementById("nim").value = "Navarro Jevie"
document.getElementById("tim").value = "Verification" 

End If

if document.getElementById("username").value = "44086785" Then

document.getElementById("nim").value = "De Vera, Ariel"
document.getElementById("tim").value = "Verification" 

End If

if document.getElementById("username").value = "45053051" Then

document.getElementById("nim").value = "Barican Grachelle Tay"
document.getElementById("tim").value = "Verification" 

End If




End Sub

</script>

<script type="text/javascript">

test0 = "";
test1 = "1.Reference Number:\r\n2.Customer Name:\r\n3.HKID/PP:\r\n4.Card Number:\r\n5.Prev Card Status:" ;
test2 = "1. Reference Number:\r\n2.Remarks:";
test3 = "1. Reference Number:\r\n2.Remarks:";
test4 = "";

function setTemplate(t) {

var otionValue = document.getElementById('template').value;

if (otionValue =="0") {

document.getElementById('adminmessage').innerHTML = test0;
} else if (otionValue =="Charge Back")

document.getElementById('adminmessage').value = test1;

else if (otionValue =="AMH Review")
document.getElementById('adminmessage').value = test2;

else if (otionValue =="TV Review")
document.getElementById('adminmessage').value = test3;

else if (otionValue =="Reconsider Reject", "GR I-QUEUE", "EXIT AFM", "Instinct Fraud", "PC Amendments", "Translation Queue(TQ)")
document.getElementById('adminmessage').value = test4;



};






</script>


<script type="text/javascript">
self.moveTo(0,0);
self.resizeTo(800,700);

</script>





<body>



<form id="frm">

<center><b> Daily Email Logsheet</center></b>

<hr color="green" size="10">

<table border="0" >
<tr>
<b><th style="text-align:left">Current Date:</th>
<th><input type="text" id="clockbox"  name="Date" readonly ></th>
</tr>

<tr>

<th style="text-align:left">User ID: </b></th>
<th><input type="text" id="username" name="StaffID" readonly  /></th>

</tr>

<tr>
<th style="text-align:left">Name: </b></th>
<th><input type="text" id="nim" name="namez" readonly  /></th>
</tr>


<tr>
<th style="text-align:left">Team: </b></th>
<th><input type="text" id="tim" name="team" readonly  /></th>

</tr>
</table>
</div>
<hr color="green" size="10">

<table border="1" align="center">
<tr>
<th>Reference Number:</th><th style="text-align:left"> <input type="text" id="name" max="20" / ><br></th>
<th>Add Data Below</th>
</tr>

<tr>
<th style="text-align:left">Type of Case: </th>
<th style="text-align:left"><select id="template" name="template" onChange = "setTemplate(this)">



<option value=""></option>
<option value="Charge Back">Charge Back</option>
<option value="AMH Review">AMH Review</option>
<option value="TV Review">TV Review</option>
<option value="Reconsider Reject">Reconsider Reject</option>
<option value="GR I-QUEUE">GR I-QUEUE</option>
<option value="EXIT AFM">EXIT AFM</option>
<option value="Instinct Fraud">Instinct Fraud</option>
<option value="PC Amendments">PC Amendments</option>
<option value="Translation Queue(TQ)">Translation Queue(TQ)</option>



</th>
<th>
<input type="button" value="Add Row" class="button" onclick="AddRow()"></th>


</tr>


</select>


<tr>


<th style="text-align:left">Platform:</th> <th style="text-align:left"><select id="plat" name="plat">


<option value="GWIS">GWIS</option>
<option value="I-QUEUE">I-QUEUE</option>
</select></th>


<th>Transfer Data</th>
</tr>




<tr>


<th style="text-align:left">Remarks:</th> <th><TEXTAREA name="adminmessage" id="adminmessage" style="text-transform:uppercase" ROWS=5 COLS=40  >

</TEXTAREA></th>

<th><input type="button" class="button" id=runbutton value="Add to DES" onclick="AddXL()"</th>

</tr>
</table>
<hr color="green" size="10">








<table id="tbl1"  border="2">
<thead>
<tr>
<th width="70px">Date</th>
<th>Staff ID</th>
<th >Name</th>
<th>Team</th>
<th>Reference Number</th>
<th >Type of Case</th>
<th>Platform</th>
<th>Remarks</th>
</tr>

</thead>
</table>
</form>

</body>

</html>
 
Upvote 0
Hello. This is vastly different to the original post. I have had a quick look, but I wonder if the problem comes from the new code you provided - I don't have time to test it now, but can you please try commenting out the following two lines:

VBA Code: 
objWorksheet.Cells.WrapText = True
 Location.reload()

You can do this by putting an apostrophe at the start of each line:

VBA Code: 
'  objWorksheet.Cells.WrapText = True
'  Location.reload()

Let me know how it goes. Also, please remember that you should only test this on dummy data and that you should always keep backups of your files (including this HTA file).
 
Upvote 0
Dan_W said:
Hello. This is vastly different to the original post. I have had a quick look, but I wonder if the problem comes from the new code you provided - I don't have time to test it now, but can you please try commenting out the following two lines:

VBA Code: 
objWorksheet.Cells.WrapText = True
 Location.reload()

You can do this by putting an apostrophe at the start of each line:

VBA Code: 
'  objWorksheet.Cells.WrapText = True
'  Location.reload()

Let me know how it goes. Also, please remember that you should only test this on dummy data and that you should always keep backups of your files (including this HTA file).
Click to expand...
Thanks for the tip.

unfortunatley, i have tried that before but still no luck.. Thanksss
 
Upvote 0
Try changing the following line (in the code you posted today):

VBA Code: 
objWorksheet.Cells.WrapText = True

to

VBA Code: 
objWorksheet.Cells.WrapText =False

I suspect that this will solve the problem, but I am only guessing what the problem might because you still haven't told me "The data is transferring not in the next available Blank cell but in the middle or sometimes worst." isn't clear.
- "next available blank cell" - where? In the next Row? The next column?
- "in the middle" - in the middle of what? What is worse than that?
A screen capture would be helpful.
 
Upvote 0
Dan_W said:
Try changing the following line (in the code you posted today):

VBA Code: 
objWorksheet.Cells.WrapText = True

to

VBA Code: 
objWorksheet.Cells.WrapText =False

I suspect that this will solve the problem, but I am only guessing what the problem might because you still haven't told me "The data is transferring not in the next available Blank cell but in the middle or sometimes worst." isn't clear.
- "next available blank cell" - where? In the next Row? The next column?
- "in the middle" - in the middle of what? What is worse than that?
A screen capture would be helpful.
Click to expand...

something like this.. I've already tried that also

1620827191363.png
 
Upvote 0
Does it happen every time you open/close the workbook and add entries? Is it always the same number of rows?
Is there anything else on the worksheet - in the other columns (for example, in column N, O, P, Q, etc)? I ask because if there is, this would explain the gap. In the original code, it uses this method to find the last row used on the spreadsheet: objWorksheet.UsedRange.SpecialCells(xlCellTypeLastCell)
 
Upvote 0
Dan_W said:
Does it happen every time you open/close the workbook and add entries? Is it always the same number of rows?
Is there anything else on the worksheet - in the other columns (for example, in column N, O, P, Q, etc)? I ask because if there is, this would explain the gap. In the original code, it uses this method to find the last row used on the spreadsheet: objWorksheet.UsedRange.SpecialCells(xlCellTypeLastCell)
Click to expand...
none. that's actually a raw excel..
 
Upvote 0
Ok - well, I've tried it another two times on two different computers, and I cannot recreate the problem you're experiencing.
When you say "raw excel", what do you mean? Remember that I did explain that the code "[assumes] that there is an existing spreadsheet with a header row (Name, Grade, etc)".
 
Upvote 0
Dan_W said:
Ok - well, I've tried it another two times on two different computers, and I cannot recreate the problem you're experiencing.
When you say "raw excel", what do you mean? Remember that I did explain that the code "[assumes] that there is an existing spreadsheet with a header row (Name, Grade, etc)".
Click to expand...
Yes it has but just diff captions as per code. Btw, thanks for the effort..
 
Upvote 0
You must log in or register to reply here.

Similar threads

X
  • Solved
HTA assign variable to textarea with Line Breaks
Replies
1
Views
757
John_w
J
M
  • Question Question
Help with FilterXML formula
Replies
0
Views
1K
montex01
M
C
  • Solved
Excel 2016 32bit VBA Pulling info from Website to Sheet
Replies
2
Views
2K
CrashOD
C
blaksnm
  • Solved
Excel automatically opens two files when loading
Replies
4
Views
588
rollis13
rollis13
P
  • Solved
How to copy a specific rows if met the conditions and paste it to another sheet using macro excel formula
2 3
Replies
28
Views
3K
airforceone
airforceone

Forum statistics

Threads
1,223,893
Messages
6,175,240
Members
452,621
Latest member
Laura_PinksBTHFT

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top