Search code examples
excelvbadownload

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


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

Solution

  • 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