Question

我试图从这里提取一些数据：http://www.hnb.hr/tecajn/f140215.dat

这是克罗地亚国家银行的汇率清单。文件名＆＃34; f140215.dat＆＃34;基本上是一个日期，按以下顺序格式化：

＆＃34; F＆＃34; ＆＃34; DDMMYY＆＃34; ＆＃34; .DAT＆＃34;

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

单元格＃1，用户将手动输入以下日期格式：＆＃34; MMM DD，YYYY＆＃34;
单元格＃2，用户将手动输入所请求的货币代码名称（美元，英镑等）
单元格＃3，其中提取的汇率应该出现在指定的日期和货币。

在桌子下面有一个＆＃34; UPDATE＆＃34;更新Cell＃3信息的按钮。我要求的脚本应该连接到该按钮。

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

根据Cell＃1中输入的日期确定要转到的页面。例如，如果Cell＃1包含＆＃34; 2015年2月14日＆＃34;，则脚本应该指向＆＃34; http://www.hnb.hr/tecajn/f140215.dat＆＃34;
在该页面上，获取指定货币的中间值小区＃2。例如，如果Cell＃2包含＆＃34; USD＆＃34;，则脚本应为
提取物＆＃34; 6,766508＆＃34;这是＆＃34; 840USD001＆＃34;的中间值。只要中间值是相关的。
将此值写入Cell＃3。

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

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

编辑：

我看了一些教程并玩了一遍，这就是我到目前为止所做的。

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的数据

1 个答案: