VBA提取物和从网站分析数据到Word(VBA extract and parse data fro

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

这是克罗地亚国家银行汇率表。文件名“f140215.dat”基本上是一个日期，按以下顺序格式化：

“F”， “日月年” 修改 “.dat”

我打算在Word表格，其中包含以下细胞组织的数据：

小区＃1，其中用户将在以下格式手动输入日期：“MMM DD，YYYY”
小区＃2，其中用户将手动输入请求的货币代码名称（USD，GBP，等）
小区＃3，其中所提取的汇率应该出现在指定日期和货币。

下面的表有一个“更新”按钮，更新小区＃3的信息。我要求应连接到该按钮的脚本。

点击该按钮后，我想脚本来做到以下几点：

找出去根据在小区＃1所输入的日期的页面。例如，如果小区＃1中包含“2015年2月14日，”脚本应该指向“ http://www.hnb.hr/tecajn/f140215.dat ”
在该页面中，抢在小区＃2中规定的货币的中间值。例如，如果小区＃2含有“美元”，该脚本会
提取物“6,766508”，这是“840USD001”的中间值。只有中间值是相关的。
写这个值到小区＃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：

好的！！取得了一定的进步！我已经成功通过分割功能解析它：

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为字符串。但是，一旦我这样做，它不会做任何事情。这是为什么？

这应该可以帮助您与您的项目上半年; 即是数据的检索。正如我在以前的评论中提到，数据检索等，这是更适合的MSXML2.ServerXMLHTT类型的对象。

你将不得不进入VBE的工具►引用，并添加微软XML 6.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