使用vba导入基于Web的数据
我使用的网站是www.msci.com。 该网站使用了几种可以改变的forms。 每个选项组合都会创build一个特定的值matrix（所需的数据）。 我想在我的Excel表格中创build相同的variables，这样我只需要在表格中填写一些代码来创build一个数据表格，这个数据表格应该放在同一张表格的其他地方。
我想我必须在我的macros中join一些html代码来填充这些向下滚动的菜单（表单）。 我发现了每个HTML表单的基础，并试图将这些选项合并到我的代码中。 我认为代码部分工作，但是从日历模板中更改date肯定不起作用。 我的代码到目前为止：
Sub getMSCIdata() Dim mktval As String Dim curr As String Dim indlvl As String Dim calendarinput As String curr = Range("$B$3") mktval = Range("$B$2") indlvl = Range("$B$4") calendarinput = Range("$B$5") With ActiveSheet.QueryTables.Add(Connection:= _ "URL;http://www.mscibarra.com/webapp/indexperf/pages/IEIPerformanceRegional.jsf?scope=0&mktval&size=36&style=C&calendarinput&curr&indlvl&lang=en" _ , Destination:=Range("$A$10")) .Name = _ "IEIPerformanceRegional.jsf?scope=0&mktval&size=36&style=C&calendarinput&curr&indlvl&lang=en" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = """templateForm:tableResult0""" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = True .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With End Sub 如果网页对于QueryTable提取数据过于复杂，则可以编写自己的VBA以直接从HTML文档中提取数据。
使用工具/参考添加参考“Microsoft HTML对象库”。
创build一个名为WB的包含大型WebBrowserControl的用户窗体。
将此代码添加到表单中：
Private Sub UserForm_Initialize() WB.navigate ("http://www.mscibarra.com/webapp/indexperf/pages/IEIPerformanceRegional.jsf?scope=0&mktval&size=36&style=C&calendarinput&curr&indlvl&lang=en") End Sub Private Sub WB_DocumentComplete(ByVal pDisp As Object, URL As Variant) Dim tBody As HTMLBody, row As HTMLTableRow Set tBody = WB.document.getElementById("templateForm:tableResult0:tbody_element") If tBody Is Nothing Then Stop For Each row In tBody.rows Debug.Print CellText(row, 1), CellText(row, 2), CellText(row, 0) Next End Sub ' returns an empty string instead of an error Private Function CellText(row As HTMLTableRow, ByVal cellIndex As Long) As String Dim Cell As HTMLTableCell On Error Resume Next Set Cell = row.Cells.Item(cellIndex) CellText = Trim(Cell.innerText) End Function
显示表单。 网页应该在几秒钟内加载。 DocumentComplete事件将运行代码来提取和打印列Index Code，Last和MSCI Index。 debugging窗口应显示：
990300 1,811.383 EAFE 991100 1,785.575 EAFE + CANADA 144097 1,372.105 EAFE ex ISRAEL 991600 2,034.280 EAFE ex UK 991300 1,487.429 EASEA INDEX (EAFE ex JAPAN) 106400 182.491 EMU 106507 169.293 EMU ex GERMANY 990600 399.741 EU 106569 1,076.915 EURO 990500 1,641.595 EUROPE 144115 1,422.575 EUROPE & MIDDLE EAST 106331 189.663 EUROPE ex EMU 995200 1,445.779 EUROPE ex SWITZERLAND 991700 1,854.892 EUROPE ex UK 990900 2,915.545 FAR EAST 113647 1,529.146 G7 INDEX 991200 1,740.757 KOKUSAI INDEX (WORLD ex JP) 990700 6,054.493 NORDIC COUNTRIES 990200 2,113.327 NORTH AMERICA 990800 2,351.421 PACIFIC 991400 1,288.304 PACIFIC ex JAPAN 106570 1,163.646 PAN-EURO 990100 1,721.971 WORLD 701609 1,859.470 WORLD WITH USA GROSS 996200 1,744.360 WORLD ex AUSTRALIA 701610 1,844.715 WORLD ex AUSTRALIA WITH USA GROSS 106330 213.390 WORLD ex EMU 106332 1,745.644 WORLD ex EUROPE 144079 1,637.763 WORLD ex ISRAEL 991500 1,754.637 WORLD ex UK 991000 1,820.809 WORLD ex USA
现在直接把这些值放到工作表中。
这项技术可以扩展到受HTTP Auth保护的网站和需要设置cookie的login网站。
您不仅限于从网页中提取数据。 您可以使用VBA填写表单元素，然后单击提交button。
向表单添加一个cmdNextPage命令buttonbutton，并添加以下代码：
Private Sub cmdNextPage_Click() Dim theForm As HTMLFormElement, el As HTMLObjectElement Set theForm = WB.document.forms("templateForm") With theForm.elements .Item("templateForm:_id78").value = "2115" ' set [Market] to "Frontier Markets (FM)" .Item("templateForm:_id88").value = "Dec 1, 2014" ' set [As of] End With theForm.submit End Sub
当testing这个时，我发现它不起作用。 表单元素得到更新，但提交没有做任何事情。 在那个网页上还有其他的东西，我没有find。 您将无法使用DocumentComplete来检测页面何时更新，因为它使用AJAX来更新结果表。 如果您使用Fiddler来查看networking上发生了什么，则可以在代码中复制AJAX请求。 对不起，我没有时间进一步解决这个问题。