I have a working macro, I just download an excel from a website, then I can use it. I need a similar file but the download icon doesn't have an own 'path' and I need to choose the format type. Can I solve with the below macro, or it's more complicated. Can you help?
https://data.ecb.europa.eu/data/datasets/FM/FM.M.U2.EUR.RT.MM.EURIBOR3MD_.HSTA
Option Explicit
Sub first()
Dim myURL As String, sFilename As String
myURL = "https://www.mnb.hu/letoltes/bubor2.xls"
sFilename = "****\" & "file.xls"
Dim WinHttpReq As Object, oStream As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False ', "username", "password"
WinHttpReq.Send
myURL = WinHttpReq.ResponseBody
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.ResponseBody
oStream.SaveToFile sFilename, 2 ' 1 = no overwrite, 2 = overwrite
oStream.Close
End If
End Sub
Run this code and see if the data is what you are looking for;
Sub Test()
Dim objHTTP As Object
Dim strJSON As String
Dim URL As String, r As Integer, c As Integer
Dim regExp As Object, RetVal As Object
Dim arrPattern(1 To 18) As Variant, xPattern As Variant, objList As ListObject
Range("A1:R" & Rows.Count) = ""
Range("A1:R1").Font.Bold = True
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
URL = "https://data.ecb.europa.eu/data-detail-api/FM.M.U2.EUR.RT.MM.EURIBOR3MD_.HSTA"
objHTTP.Open "GET", URL, False
objHTTP.send
Range("A1:R1") = Array("OBS", "SERIES", "OBS_VALUE_ENTITY", "UNIT", "PERIOD_ID", "OBS_POINT", "OBS_COM", "TREND_INDICATOR", _
"PERIOD_NAME", "LEGEND", "OBS_STATUS", "OBS_VALUE_AS_IS", "PERIOD", "FREQUENCY", "OBS_CONF", _
"PERIOD_DATA_COMP", "VALID_FROM", "OBS_PRE_BREAK")
If objHTTP.Status = 200 Then
strJSON = objHTTP.responseText
arrPattern(1) = """OBS"":""(.+?)"",""SERIES"":"
arrPattern(2) = """SERIES"":""(.+?)"",""OBS_VALUE_ENTITY"":"
arrPattern(3) = """OBS_VALUE_ENTITY"":""(.+?)"",""UNIT"":"
arrPattern(4) = """UNIT"":""(.+?)"",""PERIOD_ID"":"
arrPattern(5) = """PERIOD_ID"":""(.+?)"",""OBS_POINT"":"
arrPattern(6) = """OBS_POINT"":""(.+?)"",""OBS_COM"":"
arrPattern(7) = """OBS_COM"":""(.+?)"",""TREND_INDICATOR"":"
arrPattern(8) = """TREND_INDICATOR"":""(.+?)"",""PERIOD_NAME"":"
arrPattern(9) = """PERIOD_NAME"":""(.+?)"",""LEGEND"":"
arrPattern(10) = """LEGEND"":""(.+?)"",""OBS_STATUS"":"
arrPattern(11) = """OBS_STATUS"":""(.+?)"",""OBS_VALUE_AS_IS"":"
arrPattern(12) = """OBS_VALUE_AS_IS"":""(.+?)"",""PERIOD"":"
arrPattern(13) = """PERIOD"":""(.+?)"",""FREQUENCY"":"
arrPattern(14) = """FREQUENCY"":""(.+?)"",""OBS_CONF"":"
arrPattern(15) = """OBS_CONF"":""(.+?)"",""PERIOD_DATA_COMP"":"
arrPattern(16) = """PERIOD_DATA_COMP"":""(.+?)"",""VALID_FROM"":"
arrPattern(17) = """VALID_FROM"":""(.+?)"",""OBS_PRE_BREAK"":"
arrPattern(18) = """OBS_PRE_BREAK"":""(.+?)""}"
Set regExp = CreateObject("VBScript.RegExp")
regExp.ignorecase = True
regExp.Global = True
For Each xPattern In arrPattern
regExp.Pattern = xPattern
r = 1
c = c + 1
If regExp.Test(strJSON) Then
For Each RetVal In regExp.Execute(strJSON)
r = r + 1
Cells(r, c) = RetVal.Submatches(0)
Next
End If
Next
Set objList = ActiveSheet.ListObjects.Add(xlSrcRange, ActiveSheet.UsedRange)
With objList
.ShowTotals = False
.Name = "List_ECB"
.Range.Columns.AutoFit
End With
MsgBox "Done...!", vbInformation
Else
MsgBox "URL problem...."
End If
Set regExp = Nothing
Set objHTTP = Nothing
End Sub