Hi I got this code browsing around and tried to change to what I need but with no luck! I basically need to get in a excel spreadsheet "daily closing" for currency pairs EURUSD EURGBP and ERUAUD starting from Jan 2013 to present. So ideally, I would like to have a sheet were I have 4 columns, 1 for dates and the 3 remaining for each currency pair. Starting in 01 Jan 2013 to present and every time I run the macro it updates the table. Data needs to come from the ECB website.
Sub FxUpdate()
Dim XML_Object As Object
Dim HTMLResponse As String
Dim ECB_FX_URL As String
Dim FXstring As String, i As Integer, j As Integer
Dim USDVal As Variant, GBPVal As Variant, AUDVal As Variant
Dim FXDate As Variant, PrevDate As Variant
Dim FxTable()
Dim MidSt As Integer, MidLen As Integer
Dim MnthEnd As Boolean
Dim FirstRptDate As Date, CurRptDate As Date
Dim DateLoops As Integer
' Modified by ANY1, Feb. 17, 2021
' To run properly, MSXML needs to be referenced in Excel
' To do this, complete the following steps:
' 1. Open Visual Basic Editor (VBE) from Excel
' 2. Select Tool - References
' 3. Scroll through the list of available references and select the latest version of Microsoft XML, v 6.0 (latest as of Feb. 17, 2021)
' 4. You should also select (a) Microsoft Office 16.0 Object Library and (b) Microsoft Internet Controls
' You may also want to select Microsoft HTML Object Library, but this is not strictly required for this code to run
' The URL accesses an XML download of the ECB's daily FX Quotes back to 1999
ECB_FX_URL = "https://www.ecb.europa.eu/stats/eurofxref/eurofxref-hist.xml?affd3fe4c0ac916ce2e9d1ccfea2327c"
Application.ScreenUpdating = False
'Extract data from website to Excel using VBA
Application.StatusBar = "Downloading XML string from ECB"
Set XML_Object = CreateObject("MSXML2.ServerXMLHTTP")
XML_Object.Open "GET", ECB_FX_URL, False
XML_Object.send
HTMLResponse = XML_Object.responseText
' Find the first and last dates in the XML string
MidSt = InStr(HTMLResponse, "Cube time=") + 11
MidLen = InStr(MidSt, HTMLResponse, Chr(34)) - MidSt
FXstring = Mid(HTMLResponse, MidSt, MidLen)
CurRptDate = Mid(HTMLResponse, MidSt, MidLen)
' Calculate the maximum number of business days between the first and last report dates, ignoring holiday absences
' To find the last date, you need to Truncate the XML string to the last 2000 characters, otherwise, the count will exceed Excel's limits on the size of integers.
FXstring = Right(HTMLResponse, 2000)
MidSt = InStrRev(FXstring, "Cube time=") + 11
MidLen = InStr(MidSt, FXstring, Chr(34)) - MidSt
FirstRptDate = Mid(FXstring, MidSt, MidLen)
DateLoops = Application.WorksheetFunction.NetworkDays(FirstRptDate, CurRptDate)
ReDim FxTable(1 To DateLoops, 1 To 8)
' Clear old data
' I've created a named range in my data worksheet called "FX_Download". This is the top left cell of the range which will hold the target data.
' There should at least two blank rows above the this named range to hold the URL that is pasted into the worksheet and a reference to the source
If Range("FX_Download") <> "" Then
Range(Range("FX_Download"), Range("FX_Download").End(xlDown).Offset(0, 7)).Clear
End If
With Range("FX_Download")
.Offset(-2, 0) = "ECB Web page source:"
.Offset(-1, 0) = ECB_FX_URL
.Offset(0, 0) = "Bus. Date"
.Offset(0, 1) = "Date"
.Offset(0, 2) = "USD"
.Offset(0, 3) = "GBP"
.Offset(0, 4) = "AUD"
With Range(.Offset(0, 0), .Offset(0, 4))
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
' Reset the FXstring to the original HTMLResponse
FXstring = HTMLResponse
j = 1
Application.StatusBar = "Parsing XML string to extract USD, GBP & AUD quotes for each date"
Application.StatusBar = "Parsing XML string to extract USD and GBP quotes for each date. Loop Number: " & i & " of " & Format(DateLoops, "0,000") & "."
' Loop through XML response text, looking for each new date. The date is preceded by text which starts with the search text "Cube time="
' Truncate the string by eliminating the portion of the string prior to and including the search text
' Extract all text starting after this occurence and then look for the specific currency quotes
' Adjust the starting point by 9 (length of the search text). Since we're counting from the Right it is -9.
FXstring = Right(FXstring, Len(FXstring) - InStr(1, FXstring, "Cube time=") - 9)
' Now that the FXstring is truncated, extract the date
' Store the date of this quote in the FXDate variable, after extracting any quotes (") from the text.
' Chr(34) is the code for the " symbol
FXDate = Left(FXstring, InStr(FXstring, Chr(34) & ">"))
FXDate = Replace(FXDate, Chr(34), "", 1)
' MidSt finds the starting point for the FX quote
' MidLen finds the length of the FX quote by searching for the next occurence of the " symbol, starting from the MidSt point
' The the Mid() function extracts that date from the XML string
MidSt = InStr(FXstring, "USD" & Chr(34) & " rate=") + 11
MidLen = InStr(MidSt, FXstring, Chr(34)) - MidSt
USDVal = Mid(FXstring, MidSt, MidLen)
' Repeat with search adapted for GBP
MidSt = InStr(FXstring, "GBP" & Chr(34) & " rate=") + 11
MidLen = InStr(MidSt, FXstring, Chr(34)) - MidSt
GBPVal = Mid(FXstring, MidSt, MidLen)
' Repeat with search adapted for AUD
MidSt = InStr(FXstring, "AUD" & Chr(34) & " rate=") + 11
MidLen = InStr(MidSt, FXstring, Chr(34)) - MidSt
CADVal = Mid(FXstring, MidSt, MidLen)
With Range(Range("FX_Download").Offset(1, 0), Range("FX_Download").Offset(DateLoops, 7))
.Select
.Value = FxTable
.NumberFormat = "0.0000"
.HorizontalAlignment = xlCenter
End With
With Range(Range("FX_Download").Offset(1, 0), Range("FX_Download").Offset(DateLoops, 1))
.NumberFormat = "dd/mm/yyyy"
End With
End Sub