HTA created table to Excel

Xlacs · May 5, 2021

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.

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

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

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:

Dan_W · May 5, 2021

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.

Dan_W · May 5, 2021

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>

Xlacs · May 5, 2021

You're a life saver.. Thank you so much!

Dan_W · May 5, 2021

No problem. Glad it's working.

Xlacs · May 10, 2021

H

Dan_W said:
No problem. Glad it's working.

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. =)

Dan_W · May 10, 2021

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>

Xlacs · May 12, 2021

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>

Dan_W · May 12, 2021

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.. =[

I'm not sure I understand. What do you mean there is a big gap in rows?

Dan_W · May 12, 2021

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

A

B

C

D

E

1

Name

Grade

Status

Description

Company

2

Mr Excel

1

Mr Excel Pty Ltd

This is a description of the employee

Person status

3

Ms VBA

1

Mr Excel Pty Ltd

This is a description of the employee, VBA

Code status

4

Ms Python

2

ACompetitor Pty Ltd

This is a description of the employee, Python, at another company.

Code status

5

Great Employee A

3

Bad Co

Here is another employee description

New status

6

Great Employee B

3

Good Co

Here is another employee description

New status

7

Terrible Employee C

4

Good Co

Here is another employee description

Old status

Sheet1

HTA created table to Excel

Xlacs

Board Regular

Excel Facts

Dan_W

Well-known Member

Dan_W

Well-known Member

Xlacs

Board Regular

Dan_W

Well-known Member

Xlacs

Board Regular

Dan_W

Well-known Member

Xlacs

Board Regular

Dan_W

Well-known Member

Dan_W

Well-known Member

Similar threads

Forum statistics

Share this page

HTA created table to Excel

Board Regular

Excel Facts

Well-known Member

Well-known Member

Board Regular

Well-known Member

Board Regular

Well-known Member

Board Regular

Well-known Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock