VBA 从网站提取和解析数据到 Word

Question

我正在尝试从此处提取一些数据：http://www.hnb.hr/tecajn/f140215.dat

这是克罗地亚国家银行的汇率表。文件名 "f140215.dat" 基本上是一个日期，格式如下：

"f" "DDMMYY"“.dat”

我打算将数据组织在一个 Word table 中，其中包含以下单元格：

Cell#1 用户将在下面手动输入日期格式："MMM DD, YYYY"
Cell#2 用户将在其中手动输入请求的货币代码名称（美元、英镑等）
单元格#3 提取的汇率应该出现在指定的日期和货币。

在 table 下方有一个 "UPDATE" 按钮，用于更新 Cell#3 信息。我要的脚本应该连接到那个按钮。

点击按钮后，我希望脚本执行以下操作：

根据单元格 #1 中输入的日期确定要转到的页面。例如，如果 Cell#1 包含 "February 14, 2015"，脚本应该指向“http://www.hnb.hr/tecajn/f140215.dat”
在该页面上，获取指定货币的中间值细胞#2。例如，如果 Cell#2 包含 "USD"，脚本应该
提取“6,766508”，这是“840USD001”的中间值。仅有的中间值是相关的。
将此值写入单元格#3。

所以总而言之，根据两个 table 单元格中指定的条件，脚本需要确定要转到的页面以及从中提取的数据，并使用该数据填充第三个单元格。

希望我解释得足够好。这只是我正在构建的整个发票生成器的一部分。到目前为止，我已经完成了所有工作，但这我真的不知道如何开始。如果需要，我可以发送整个内容，但我认为它并不完全相关。

编辑：

我看了一些教程并试了一下，这就是我到目前为止所得到的。

Enum READYSTATE
    READYSTATE_UNINITIALIZED = 0
    READYSTATE_LOADING = 1
    READYSTATE_LOADED = 2
    READYSTATE_INTERACTIVE = 3
    READYSTATE_COMPLETE = 4
End Enum

Sub Test()

Dim ie As New InternetExplorer
ie.Visible = False
ie.navigate "http://www.hnb.hr/tecajn/f140215.dat"

Do While ie.READYSTATE <> READYSTATE_COMPLETE
DoEvents
Loop

Dim html As HTMLDocument
Set html = ie.document

MsgBox html.DocumentElement.innerText

End Sub

我知道这并不多，但就像我说的，我是新手。我能够将数据放入消息框中，但我不知道如何解析它，否则我真的不能做上面提到的任何事情。现在怎么办？

编辑 2：

好的！！取得了一些进展！我已经设法通过使用 split 函数来解析它：

Sub Test()

Dim ie As New InternetExplorer
ie.Visible = False
ie.navigate "http://www.hnb.hr/tecajn/f140215.dat"

Do While ie.READYSTATE <> READYSTATE_COMPLETE
DoEvents
Loop

Dim html As HTMLDocument
Set html = ie.document

Dim getData As String
getData = html.DocumentElement.innerText

'replaced all the space fields with line breaks
Dim repData As String
repData = Replace(getData, "       ", vbCrLf)

'used line breaks as separators
Dim splData As Variant
splData = Split(repData, vbCrLf)

MsgBox splData(1)
MsgBox splData(2)
MsgBox splData(3)

End Sub

现在它在消息框中显示解析的数据。剩下的应该很简单！

OP 评论的附录：

这是后续代码的一部分：

Dim cur As String
cur = ActiveDocument.SelectContentControlsByTitle("valCombo").Item(1).Range.Text
If cur = "USD" Then
  ActiveDocument.Tables(1).Cell(7, 3).Range.Text = splData(40) & " HRK"
End If
If cur = "EUR" Then
  ActiveDocument.Tables(1).Cell(7, 3).Range.Text = splData(20) & " HRK"
End If

这种方式可行，但我想将 ActiveDocument.Tables(1).Cell(7, 3).Range.Text 设置为字符串。但是，一旦我这样做，它就什么也做不了。这是为什么？

Answer 1

这应该可以帮助您完成项目的前半部分；那是数据的检索。正如我在之前的评论中提到的，像这样的数据检索更适合 MSXML2.ServerXMLHTT 类型的对象。

您必须进入 VBE 的工具 ► 参考并添加 Microsoft XML v6.0.

Sub scrape_CNB()
    Dim u As String, dtDATE As Date, xmlHTTP As MSXML2.ServerXMLHTTP60
    Dim sTMP As String, sCURR As String
    Dim i As Long, j As Long, vLINE As Variant, vRATE As Variant

    On Error GoTo CleanUp

    Set xmlHTTP = New MSXML2.ServerXMLHTTP60

    sCURR = "USD"
    dtDATE = CDate("February 14, 2015")
    With xmlHTTP
        u = "http://www.hnb.hr/tecajn/f" & Format(dtDATE, "ddmmyy") & ".dat"
        .Open "GET", u, False
        .setRequestHeader "Content-Type", "text/xml"
        .send
        If .Status <> 200 Then GoTo CleanUp

        sTMP = .responseText
        vLINE = Split(sTMP, Chr(13) & Chr(10))
        For i = LBound(vLINE) To UBound(vLINE)
            If CBool(InStr(1, vLINE(i), sCURR, vbTextCompare)) Then
                Do While CBool(InStr(1, vLINE(i), Chr(32) & Chr(32))): vLINE(i) = Replace(vLINE(i), Chr(32) & Chr(32), Chr(32)): Loop
                vRATE = Split(vLINE(i), Chr(32))
                For j = LBound(vRATE) To UBound(vRATE)
                    MsgBox j & ": " & vRATE(j)
                Next j
                Exit For
            End If
        Next i

    End With

CleanUp:
    Set xmlHTTP = Nothing
End Sub

由于您没有启动完整的 Internet.Explorer 对象，这应该会快得多并且返回的 .responseText 是原始文本，而不是 HTML。

TBH，我发现在 Word 中基于 VBA 的光标位置编程很难处理；更喜欢与 Excel 工作表的一对一明确定义的关系。您可能需要考虑使用 Excel 作为数据存储库并与 Word 合并以提供您的发票输出。

附录：

Dim cur As String, t as long, r as long, c as long
cur = ActiveDocument.SelectContentControlsByTitle("valCombo").Item(1).Range.Text
t = 1: r = 7: c = 3
Select Case cur
  Case "USD"
    ActiveDocument.Tables(t).Cell(r, c).Range.Text = splData(40) & " HRK"
  Case "EUR"
    ActiveDocument.Tables(t).Cell(r, c).Range.Text = splData(20) & " HRK"
End Select

VBA 从网站提取和解析数据到 Word

VBA extract and parse data from website to Word

vba

parsing

ms-word

web-scraping