POST网站表单数据并检索结果 [英] POST website form data and retrieve results

问题描述

我一直在尝试编写一个VBA代码来复制这三个表，如下面的Web源代码所示。这些表显示每月天气数据。有人可以帮我写一个代码来复制这些数据并将其粘贴到Excel表中？我写了一个VBA代码来访问这些数据，但是无法复制和粘贴这些数据。非常感谢你。

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.

网页源代码：

 </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;

我写的是这样的：

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/grid.cgi?email=[e-mail]")

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

但是，没有数据被复制到excel文件中。

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

推荐答案

目前尚不清楚您正在使用什么方法访问网页，但这里是一个循环遍历所有表的XMLHTTP示例的一个网页，并将单元格值返回到Sheet1。

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=[e-mail]&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

我使用XMLHTTP方法将表单数据POST到CGI表单中。您不可能直接使用基于浏览器的方法访问该页面。一个InternetExplorer.Application方法可能需要去表单，填写并提交它到达同一页面。此外，与XMLHTTP相比，加载浏览器对象的开销（和时间）是巨大的。

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.

您将需要浏览工具►参考并添加Microsoft Internet Controls，Microsoft HTML对象库和 Microsoft XML 6.0 到您的项目。

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.

请注意，我正在检查< th>和< td> < tr>内的元素。可以想象到至少有一个级别的错误控制，但是我从来没有真正看到任何< table>没有至少一个< tr>。

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

这篇关于POST网站表单数据并检索结果的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！