Html 发布网站表单数据并检索结果

我一直在尝试编写一个VBA代码来复制这三个表，如下面的web源代码所示。这些表格显示了每月的天气数据。有人能帮我写一个代码来复制这些数据并粘贴到Excel表格中吗？我已编写VBA代码来访问此数据，但无法复制和粘贴此数据。事先非常感谢

网页源代码：

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

但是，电子表格中没有数据。你能告诉我代码有什么问题吗？谢谢

根据Jeeped的建议，我尝试了以下代码：

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=skip@larc.nasa.gov")

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

Sub-extractSolData（）
模糊的物体
Dim r为整数，c为整数，t为整数
将iTD调暗为Long，iTR调暗为Long，eTR调暗为MSHTML.IHTMLElement，ECTR调暗为IHTMLElementCollection
设置IE=CreateObject（“InternetExplorer.Application”）
纬度=输入框（“输入位置的纬度”）
经度=输入框（“输入位置的经度”）
与IE
可见=真实
例如，导航（“https://eosweb.larc.nasa.gov/cgi-bin/sse/grid.cgi?email=skip@larc.nasa.gov.）
而IE.readyState 4
多芬特
温德
IE.document.getElementsByName（“lat”）.Item.innerText=纬度
IE.document.getElementsByName（“lon”）.Item.innerText=经度
IE.document.getElementsByName（“提交”）.Item.Click
在忙的时候做
对于IE.document.all.Item（“swv_dwn”）选项中的每个obj
如果obj.Value=“clr\u sky”，则
所选对象=真
如果结束
如果obj.Value=“clr_kt”，则
所选对象=真
如果结束
下一个obj
对于IE.document.all.Item（“RH10M”）选项中的每个obj
如果obj.Value=“col\u precip”，则
所选对象=真
如果结束
下一个obj
IE.document.getElementsByName（“提交”）.Item.Click
在忙的时候做
如果是CBool（即document.getElementsByTagName（“table”）.Length），那么
对于iTBL=0到（即document.getElementsByTagName（“表”）。长度-1）
Set ecTRs=IE.document.getElementsByTagName（“表格”）（iTBL.getElementsByTagName（“tr”）
对于iTR=0到（ecTRs.Length-1）
如果是CBool（ecTRs（iTR）.getElementsByTagName（“th”）.Length），那么
对于iTD=0到（ecTRs（iTR）.getElementsByTagName（“th”）.Length-1）
ThisWorkbook.Sheets（“Sheet1”）.Cells（iTR+1，iTD+1）=ecTRs（iTR）.getElementsByTagName（“th”）.innerText
下一个iTD
ElseIf CBool（ecTRs（iTR）.getElementsByTagName（“td”）.Length）然后
对于iTD=0到（ecTRs（iTR）.getElementsByTagName（“td”）.Length-1）
ThisWorkbook.Sheets（“Sheet1”）.Cells（iTR+1，iTD+1）=ecTRs（iTR）.getElementsByTagName（“td”）.innerText
下一个iTD
如果结束
下一个iTR
设置ecTRs=无
下一个iTBL
如果结束
以
设置IE=无
端接头

---

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

不清楚您使用什么方法访问网页，但下面是一个XMLHTTP示例，它循环遍历网页的所有表，并将单元格值返回给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=skip@larc.nasa.gov&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方法将表单数据发布到CGI表单中。使用基于浏览器的方法不太可能直接访问页面。一个InternetExplorer.Application方法可能需要转到表单，填写表单并提交到同一页面。此外，与XMLHTTP相比，加载浏览器对象的开销（和时间）是巨大的

你需要检查一下工具► 参考并将Microsoft internet控件、Microsoft HTML对象库和Microsoft XML 6.0添加到项目中

---

请注意，我正在检查中的和元素。可以想象至少还有一个错误控制级别，但我从来没有见过任何一个级别没有错误控制级别。

帮助？还是为你做？嗯，我试过很多次了，但是我的代码有问题。我已经在我的问题中添加了我到目前为止所写的内容。你能告诉我代码有什么问题吗？它似乎没有复制电子表格中的数据。非常感谢。你试过调试吗？

msgboxelemcollection.Length

说明了什么？显示完整的HTML和VBA。还有，你从哪个链接获得该页面？请首先发布显示如何加载页面的代码OmeGastripes:谢谢！！MsgBox显示“0”。我现在发布了我试图使用的完整代码。谢谢你的回复！！我正在使用Internet Explorer访问网页。使用您的方法，我编写了一个代码，但仍然无法运行。它执行宏，但工作簿中没有数据。我已将完整的代码粘贴到我的问题上。请检查是否有任何错误。@user1671860-您正试图直接访问带有表单数据的CGI页面。这一点很重要。如果不转到表单数据页面，填写并提交表单数据，您不可能取得很大成功。XMLHTTP方法可以将数据直接发布到CGI。请看上面。非常感谢！！我将尝试修改代码并让您知道。当我使用您的代码时，它不是复制整个页面，而是只复制几个部分。您没有正确地传递POST数据。查看我的最新版本。谢谢！根据您的建议，我能够提取所需的数据。我真诚地感谢你的帮助，兄弟！！

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=skip@larc.nasa.gov&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