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:
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Sort by date Sort by votes
Hi. This line limits the transfer of data to the table header row:
For Each cell In tbl1.thead.rows(0).Cells
Give me some time and let me read the rest of the code to see how best to rewrite it.
 
Upvote 0
Hi, the code below should work now. The only part I needed to change was this part:
VBA Code: 
intRow = 1
    For Each tblRow In tbl1.Rows
        intCol = 1
        For Each cell In tblRow.Cells
            objWorksheet.Cells(intRow, intCol).value = cell.InnerText
            intCol = intCol + 1
        Next
        intRow = intRow + 1
    Next
Previously, your code would iterate through each cell of only the header row. This iterates through each row of the table (tblRow), extracting each of the cells of the row as it goes. Hope that helps.

VBA Code: 
<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()
    Dim intRow, intCol
    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
    
    intRow = 1
    For Each tblRow In tbl1.Rows
        intCol = 1
        For Each cell In tblRow.Cells
            objWorksheet.Cells(intRow, intCol).value = cell.InnerText
            intCol = intCol + 1
        Next
        intRow = intRow + 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>
 
Upvote 0
Solution
H
Dan_W said:
No problem. Glad it's working.
Click to expand...
Hi Dan

Just a small problem with the code you provided.
When I try to continuously submitting the data in to the excel, all the content of the workbook has been overwritten.
It should be submitted to the next available blank cell.

Also, when submitting the data, the caption header like (Name, Grade, Company, Description, status should not be included.
Only the the data submitted within the cells.

hope to hear from you. =)
 
Upvote 0
Hi

Try the code below. I've tested it, and assuming that there is an existing spreadsheet with a header row (Name, Grade, etc), then this should add onto the existing data set. It should now also skip adding another header row - the solution I've used isn't particularly elegant, but it works. Let me know how it goes:

VBA Code: 
<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()
    Dim intRow, intCol, blnHeaderRow
    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
    
    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
    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>
 
Upvote 0
Hi Dan,

Thank your the quick response.

Unforunately, the code works but the data once transferred in excel has a big gap in rows. Hmm it doesnt move to the next blank cell.. =[
Dan_W said:
Hi

Try the code below. I've tested it, and assuming that there is an existing spreadsheet with a header row (Name, Grade, etc), then this should add onto the existing data set. It should now also skip adding another header row - the solution I've used isn't particularly elegant, but it works. Let me know how it goes:

VBA Code: 
<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()
    Dim intRow, intCol, blnHeaderRow
    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
   
    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
    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>
Click to expand...
 
Upvote 0
Xlacs said:
Hi Dan,

Thank your the quick response.

Unforunately, the code works but the data once transferred in excel has a big gap in rows. Hmm it doesnt move to the next blank cell.. =[
Click to expand...
I'm not sure I understand. What do you mean there is a big gap in rows?
 
Upvote 0
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
 
Last edited:
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