使用 vba 导入基于 Web 的数据

Question

我使用的网站是 www.msci.com。该网站使用了几种可以更改的表格。每个选择组合都会创建一个特定的值矩阵（所需的数据）。我想在我的 excel 工作表中创建相同的变量，这样我只需在工作表的 B 列中填写一些代码即可创建一个数据表，该数据表应放置在同一张工作表的其他位置。

我想我必须在我的宏中加入一些 html 代码来填充这些向下滚动的菜单（表单）。我发现了表单中的每个选项的 html ID，并尝试将它们合并到我的代码中。我认为代码部分有效，但是从日历模板更改日期肯定不起作用。到目前为止我的代码：

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

Answer 1

如果网页过于复杂，QueryTable 无法提取数据，您可以编写自己的 VBA 直接从 HTML 文档中提取数据。

使用工具/参考添加参考“Microsoft HTML 对象库”。

创建一个包含名为 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。调试窗口应显示：

    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 的网站。

您不仅限于从网页中提取数据。您可以使用 VBA 填写表单元素并单击提交按钮。

在表单中添加一个 cmdNextPage 命令按钮按钮，并添加以下代码：

    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

在测试这个时，我发现它不起作用。表单元素得到更新，但提交没有做任何事情。该网页上还有其他一些事情我没有追踪到。您将无法使用 DocumentComplete 来检测页面何时更新，因为它使用 AJAX 来更新结果表。如果您使用 Fiddler 查看网络上发生了什么，您可能能够在代码中复制 AJAX 请求。很抱歉，我没有时间进一步解决此问题。