Search code examples
excelvbahta

HTA created table to Excel


I found a code related to my idea and decided to tweak it a little bit. Anyway. 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,

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"
  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>

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


Solution

  • Something like this (tested):

    Sub Submit()
        strFileName = "C:\Tester\Data.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
        
        Set objTable = document.getElementById("tbl1") 
        
        rw = 1
        For Each row In objTable.ROWS
            col = 1
            for each cell in row.cells
                objWorksheet.Cells(rw, col).Value = cell.innerText
                col = col + 1
            next 
            rw = rw + 1
        next 
    End Sub