问题
I'm trying to extract some data from here: http://www.hnb.hr/tecajn/f140215.dat
This is the exchange rate list from the Croatian National Bank. The file name "f140215.dat" is basically a date, formatted in the following order:
"f" "DDMMYY" ".dat"
I intend to have the data organized in a Word table, which contains the following cells:
- Cell#1 where a user would manually input a date in the following format: "MMM DD, YYYY"
- Cell#2 where a user would manually input the requested currency code name (USD, GBP, etc)
- Cell#3 where the extracted exchange rate should appear for the specified date and currency.
Underneath the table there is an "UPDATE" button that updates the Cell#3 information. The script I'm asking for should be connected to that button.
After clicking the button, I'd like the script to do the following:
- Figure out which page to go to based on the date inputted in Cell #1. For example, if the Cell#1 contains "February 14, 2015", the script should point to "http://www.hnb.hr/tecajn/f140215.dat"
- On that page, grab the middle value for the currency specified in
Cell#2. For example, if Cell#2 contains "USD", the script should
extract "6,766508" which is the middle value for "840USD001". Only the middle value is relevant. - Write this value to Cell#3.
So to sum it up, based in the criteria specified in the two table cells, the script needs to identify which page to go to and what data to extract from it, and with that data populate the third cell.
Hope I explained it well enough. This is only a part of the whole invoice generator I'm building. So far I've gotten everything to work, but this I really don't even know how to start. I can send the whole thing if needed, but figured it's not exactly relevant.
EDIT:
I watched some tutorials and played around, and this is what I got so far.
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
I know it's not much, but like I said, I'm new at this. I was able to get the data into the message box, but I have no idea how to parse it, and without that I can't really do anything mentioned above. What now?
EDIT 2:
Alright!! Made some progress! I've managed to parse it by using the split function:
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
Right now it displays the parsed data in message boxes. The rest should be easy!
Addendum from OP's comment:
This is a part of the continued code:
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
This way it works, but I'd like to set ActiveDocument.Tables(1).Cell(7, 3).Range.Text as a string. However, once I do that, it doesn't do anything. Why is that?
回答1:
This should help you with the first half of your project; that being the retrieval of the data. As I mentioned in my earlier comment, data retrieval such as this is better suited to an MSXML2.ServerXMLHTT type of object.
You will have to go into the VBE's Tools ► References and add 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
Since you are not initiating a full Internet.Explorer object, this should be much quicker and the .responseText that is returned is raw text, not HTML.
TBH, I find the cursor position based VBA programming within Word to be hard to deal with; preferring the one-to-one explicitly defined relationship(s) with an Excel worksheet. You may want to consider using Excel as a data repository and merging with Word to provide your invoice output.
Addendum:
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
来源：https://stackoverflow.com/questions/28517857/vba-extract-and-parse-data-from-website-to-word