Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
555 views
in Technique[技术] by (71.8m points)

html - POST website form data and retrieve results

I have been trying to write a VBA code to copy these three tables as shown in the web source code below. These tables show monthly weather data. Could someone please help me write a code to copy this data and paste it in a Excel sheet? I have written a VBA code to access this data but could not copy and paste this data. Thank you very much in advance.

The webpage source code:

 </table>
</div>
<hr><big><b><i>Parameters for Sizing and Pointing of Solar Panels and for Solar Thermal Applications:</i></b></big>
<hr width="80%">
<a name="clr_sky"></a>
<div align="center"><table border=1 summary="Monthly Averaged Clear Sky Insolation Incident On A Horizontal Surface " width="95%">
<caption><b>Monthly Averaged Clear Sky Insolation Incident On A Horizontal Surface (kWh/m<sup>2</sup>/day)</b></caption><tr><td>Lat 32 <br> Lon 75</td>
<td>Jan</td><td>Feb</td><td>Mar</td><td>Apr</td><td>May</td><td>Jun</td>
<td>Jul</td><td>Aug</td><td>Sep</td><td>Oct</td><td>Nov</td><td>Dec</td>
<td>Annual<br>Average</td></tr>
<tr><td>22-year Average     </td><td align="center" nowrap>4.17</td><td align="center" nowrap>5.29</td><td align="center" nowrap>6.64</td><td align="center" nowrap>7.92</td><td align="center" nowrap>8.65</td><td align="center" nowrap>8.78</td><td align="center" nowrap>8.31</td><td align="center" nowrap>7.48</td><td align="center" nowrap>6.60</td><td align="center" nowrap>5.63</td><td align="center" nowrap>4.44</td><td align="center" nowrap>3.82</td><td align="center" nowrap>6.48</td>
</tr></table></div>
<div align="center"><b><i>
<a href="/sse/text/definitions.html#clr_sky" onClick="window.open('/sse/text/definitions.html#clr_sky','Definitions','menubar=yes,resizable=yes,scrollbars=yes,toolbar=yes,width=600,height=400'); return false">Parameter Definition</a> &nbsp;  &nbsp;  &nbsp;  &nbsp;  &nbsp;

</i></b></div>
<hr width="80%">
<a name="clr_kt"></a>
<div align="center"><table border=1 summary="Monthly Averaged Clear Sky Insolation Clearness Index " width="95%">
<caption><b>Monthly Averaged Clear Sky Insolation Clearness Index (0 to 1.0)</b></caption><tr><td>Lat 32 <br> Lon 75</td>
<td>Jan</td><td>Feb</td><td>Mar</td><td>Apr</td><td>May</td><td>Jun</td>
<td>Jul</td><td>Aug</td><td>Sep</td><td>Oct</td><td>Nov</td><td>Dec</td>
</tr>
<tr><td>22-year Average     </td><td align="center" nowrap>0.75</td><td align="center" nowrap>0.76</td><td align="center" nowrap>0.76</td><td align="center" nowrap>0.77</td><td align="center" nowrap>0.77</td><td align="center" nowrap>0.76</td><td align="center" nowrap>0.73</td><td align="center" nowrap>0.71</td><td align="center" nowrap>0.72</td><td align="center" nowrap>0.75</td><td align="center" nowrap>0.75</td><td align="center" nowrap>0.74</td>
</tr></table></div>
<div align="center"><b><i>
<a href="/sse/text/definitions.html#clr_kt" onClick="window.open('/sse/text/definitions.html#clr_kt','Definitions','menubar=yes,resizable=yes,scrollbars=yes,toolbar=yes,width=600,height=400'); return false">Parameter Definition</a> &nbsp;  &nbsp;  &nbsp;  &nbsp;  &nbsp;

</i></b></div>
<hr><big><b><i>Meteorology (Other):</i></b></big>
<hr width="80%">
<a name="col_precip"></a>
<div align="center"><table border=1 summary="Monthly Averaged Total Column Precipitable Water " width="95%">
<caption><b>Monthly Averaged Total Column Precipitable Water (cm)</b></caption><tr><td>Lat 32 <br> Lon 75</td>
<td>Jan</td><td>Feb</td><td>Mar</td><td>Apr</td><td>May</td><td>Jun</td>
<td>Jul</td><td>Aug</td><td>Sep</td><td>Oct</td><td>Nov</td><td>Dec</td>
<td>Annual<br>Average</td></tr>
<tr><td>22-year Average     </td><td align="center" nowrap>0.66</td><td align="center" nowrap>0.76</td><td align="center" nowrap>0.97</td><td align="center" nowrap>1.18</td><td align="center" nowrap>1.49</td><td align="center" nowrap>2.19</td><td align="center" nowrap>3.28</td><td align="center" nowrap>3.31</td><td align="center" nowrap>2.20</td><td align="center" nowrap>1.08</td><td align="center" nowrap>0.74</td><td align="center" nowrap>0.66</td><td align="center" nowrap>1.54</td>
</tr></table></div>
<div align="center"><b><i>
<a href="/sse/text/definitions.html#col_precip" onClick="window.open('/sse/text/definitions.html#col_precip','Definitions','menubar=yes,resizable=yes,scrollbars=yes,toolbar=yes,width=600,height=400'); return false">Parameter Definition</a> &nbsp;  &nbsp;  &nbsp;  &nbsp;  &nbsp;

What I have written is this:

Set elemCollection = IE.Document.getElementsByTagname("table")

For t = 0 To (elemCollection.Length - 1)
    For r = 0 To (elemCollection(t).Rows.Length - 1)
        For c = 0 To (elemCollection(t).Rows(r).Cells.Length - 1)

        ThisWorkbook.Worksheets(1).Cells(r + 1, c + 1) = elemCollection(t).Rows(r).Cells(c).innertext
        Next c
        Next r
        Next t

End With

Set IE = Nothing

However, no data comes to the spreadsheet. Could you please suggest what is wrong with the code? Thanks!

Based on Jeeped's suggestion, I tried this code:

Sub extractSolData()
Dim IE As Object
Dim r As Integer, c As Integer, t As Integer
Dim iTD As Long, iTR As Long, eTR As MSHTML.IHTMLElement, ecTRs As IHTMLElementCollection

Set IE = CreateObject("InternetExplorer.Application")

latitude = InputBox("Enter Latitude of the location")
longitude = InputBox("Enter Longitude of the location")

With IE
IE.Visible = True
IE.navigate ("https://eosweb.larc.nasa.gov/cgi-bin/sse/[email protected]")

While IE.readyState <> 4
DoEvents
Wend

IE.document.getElementsByName("lat").Item.innerText = latitude
IE.document.getElementsByName("lon").Item.innerText = longitude

IE.document.getElementsByName("submit").Item.Click
Do While IE.Busy: DoEvents: Loop

For Each obj In IE.document.all.Item("swv_dwn").Options
If obj.Value = "clr_sky" Then
obj.Selected = True
End If

If obj.Value = "clr_kt" Then
obj.Selected = True
End If
Next obj

For Each obj In IE.document.all.Item("RH10M").Options
If obj.Value = "col_precip" Then
obj.Selected = True
End If
Next obj

IE.document.getElementsByName("submit").Item.Click
Do While IE.Busy: DoEvents: Loop

If CBool(IE.document.getElementsByTagName("table").Length) Then
    For iTBL = 0 To (IE.document.getElementsByTagName("table").Length - 1)
        Set ecTRs = IE.document.getElementsByTagName("table")(iTBL).getElementsByTagName("tr")
        For iTR = 0 To (ecTRs.Length - 1)
            If CBool(ecTRs(iTR).getElementsByTagName("th").Length) Then
                For iTD = 0 To (ecTRs(iTR).getElementsByTagName("th").Length - 1)
                    ThisWorkbook.Sheets("Sheet1").Cells(iTR + 1, iTD + 1) = ecTRs(iTR).getElementsByTagName("th")(iTD).innerText
                Next iTD
            ElseIf CBool(ecTRs(iTR).getElementsByTagName("td").Length) Then
                For iTD = 0 To (ecTRs(iTR).getElementsByTagName("td").Length - 1)
                    ThisWorkbook.Sheets("Sheet1").Cells(iTR + 1, iTD + 1) = ecTRs(iTR).getElementsByTagName("td")(iTD).innerText
                Next iTD
            End If
        Next iTR
        Set ecTRs = Nothing
    Next iTBL
End If
End With
Set IE = Nothing

End Sub

However, no data is being copied into the excel file.

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

It is unclear on what method you are using to access the web page but here is an XMLHTTP example that loops through all tables of a web page and returns the cell values to Sheet1.

Dim htmlBDY As HTMLDocument, xmlHTTP As New MSXML2.ServerXMLHTTP60
Dim iTD As Long, iTR As Long, iTBL As Long, eTR As MSHTML.IHTMLElement, ecTRs As IHTMLElementCollection
xmlHTTP.Open "POST", "https://eosweb.larc.nasa.gov/cgi-bin/sse/grid.cgi", False
xmlHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
'this post string uses the sample data on the form page. You can concatenate a string var to do the same thing
xmlHTTP.send "[email protected]&step=1&lat=33.5&lon=-80.75"

Set htmlBDY = New HTMLDocument
htmlBDY.body.innerHTML = xmlHTTP.responseText

If CBool(htmlBDY.getElementsByTagName("table").Length) Then
    For iTBL = 0 To (htmlBDY.getElementsByTagName("table").Length - 1)
        Set ecTRs = htmlBDY.getElementsByTagName("table")(iTBL).getElementsByTagName("tr")
        For iTR = 0 To (ecTRs.Length - 1)
            If CBool(ecTRs(iTR).getElementsByTagName("th").Length) Then
                For iTD = 0 To (ecTRs(iTR).getElementsByTagName("th").Length - 1)
                    Sheet1.Cells(iTR + 1, iTD + 1) = ecTRs(iTR).getElementsByTagName("th")(iTD).innerText
                Next iTD
            ElseIf CBool(ecTRs(iTR).getElementsByTagName("td").Length) Then
                For iTD = 0 To (ecTRs(iTR).getElementsByTagName("td").Length - 1)
                    Sheet1.Cells(iTR + 1, iTD + 1) = ecTRs(iTR).getElementsByTagName("td")(iTD).innerText
                Next iTD
            End If
        Next iTR
        Set ecTRs = Nothing
    Next iTBL
End If

Set htmlBDY = Nothing
Set xmlHTTP = Nothing

I am using the XMLHTTP method to POST the form data into the CGI form. It is unlikely that you will be able to get to the page directly with a browser-based method. An InternetExplorer.Application method would likely have to go to the form, fill it in and submit it to get to the same page. Besides, the overhead (and time) of loading a browser object is huge compared to XMLHTTP.

????MSXML2.ServerXMLHTTP60 Form Submission

You will need to go through Tools ? References and add Microsoft internet Controls, Microsoft HTML Object library and Microsoft XML 6.0 to your project.

Note that I am checking for both <th> and <td> elements within the <tr>'s. There could conceivably be at least one more level of error control but I've never really seen any <table> that did not have at least one <tr>.


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

2.1m questions

2.1m answers

60 comments

57.0k users

...