How to download a CSV file via Excel macro plus choose the type of the file

Question

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

What happens when you run the macro?

CHill60
– CHill60

2024-12-12 14:18:20 +00:00
Commented Dec 12, 2024 at 14:18 — CHill60
– CHill60, Commented Dec 12, 2024 at 14:18
"Problems During Load" The file saves the website to excel

Danhadnagy
– Danhadnagy

2024-12-12 15:34:45 +00:00
Commented Dec 12, 2024 at 15:34 — Danhadnagy
– Danhadnagy, Commented Dec 12, 2024 at 15:34

Haluk · Accepted Answer · 2024-12-13 08:48:12Z

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

Collectives™ on Stack Overflow

How to download a CSV file via Excel macro plus choose the type of the file

1 Answer 1

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related