vbams-accessquandlurlmon

Using urlmon API Function to download data from Quandl.com to Access database, using VBA


Overview
I use www.quandl.com free financial data to predict Asset price movements.

Approach
I built a function to download the data using the quandl API. I declare a windows API function located in urlmon.dll system 32 folder.

Code

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" ( _
        ByVal pCaller As LongPtr, _
        ByVal szURL As String, _
        ByVal szFileName As String, _
        ByVal dwReserved As LongPtr, _
        ByVal lpfnCB As LongPtr) As LongPtr
#Else
    Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownLoadToFileA" ( _
        ByVal pCaller As Long, _
        ByVal szURL As String, _
        ByVal szFileName As String, _
        ByVal dwReserved As Long, _
        ByVal lpfnCB As LongPtr) As Long
#End If

Sub DownloadSingleFile()

    Dim FileURL As String
    Dim DestinationFile As String
    
    FileURL = "https://www.quandl.com/api/v3/datasets/WIKI/FB/data.csv?"
    DestinationFile = "C:\Users\hueve\Desktop\TheSystem\Fb.csv"

    URLDownloadToFile 0, FileURL, DestinationFile, 0, 0

End Sub

Problem
This code will download the data to the correct file destination.

Is there a way to instead run it to an Access DB Table?


Solution

  • Here is code with an array that pulls a single data point (52 week performance):

        ' save 52 week performance for any scored quarter not saved yet
    Set rs = CurrentDb.OpenRecordset("Select * from qryQuarterlyStockDataMissing")
    If Not rs.EOF Then
        ' some 52 week performance scores for scored companies are missing.
        rs.MoveLast
        rs.MoveFirst
        intI = rs.RecordCount
        Do While rs.EOF = False
            StatBar_Msg "Updating 52 Week Performance Data for " & intI & " scored periods..."
            strLink = GetQuandl52WeekPerformanceLink(rs![Ticker], rs![Active_Period])
            dbl52WeekPerformance = Nz(GetQuandl52WeekPerformance(strLink), "NULL")
            strSQL = "INSERT INTO tblQuarterlyStockData (SDF_Details_ID, 52WeekPerformance, QuandlLink) " & _
                    "VALUES(" & rs![SDF_Details_ID] & "," & CStr(dbl52WeekPerformance) & _
                    ",'" & strLink & "')"
            CurrentDb.Execute strSQL
            rs.MoveNext
            intI = intI - 1
        Loop
        rs.Close
        Set rs = Nothing
    End If
    
    Public Function GetQuandl52WeekPerformanceLink(strTicker As String, dtDate As Date)
    Dim strLink As String
    Dim strStartDate As Date
    Dim strEndDate As Date
    Dim strResponse As String
    Dim objHttp As Object
    Dim LArray() As String
    Dim dtEndDate As Date
    Dim dtStartDate As Date
    
    ' find nearest weekday date
    dtEndDate = GetNearestStockDay(dtDate)
    dtStartDate = dtEndDate - 367 ' make it slightly more than a year in case the previous year date falls on a Sunday
    
    GetQuandl52WeekPerformanceLink = "https://www.quandl.com/api/v3/datasets/WIKI/" & strTicker & _
                ".csv?column_index=4&start_date=" & Format(dtStartDate, "yyyy-mm-dd") & _
                "&end_date=" & Format(dtEndDate, "yyyy-mm-dd") & "&collapse=annual&transform=rdiff&api_key=ryCL1ih7fJ1eTH8y9U7E"
    End Function
    
    
    
    Public Function GetQuandl52WeekPerformance(strLink As String)
    Dim strResponse As String
    Dim objHttp As Object
    Dim LArray() As String
    
    Set objHttp = CreateObject("MSXML2.XMLHTTP")
    
    objHttp.Open "Get", strLink, False
    objHttp.send
    strResponse = objHttp.responseText
    Set objHttp = Nothing
    
    LArray = Split(strResponse, ",")
    
    GetQuandl52WeekPerformance = Null
    If LArray(0) = "code" Then
        ' no data returned
    Else
        If Len(strResponse) > 12 Then
            GetQuandl52WeekPerformance = LArray(2)
        Else
            ' This stock doesn't have a full year's worth of data
        End If
    End If
    End Function
    
    Public Function GetNearestStockDay(dtDate As Date) As Date
    If Weekday(dtDate) = 1 Then
        GetNearestStockDay = dtDate - 2
    ElseIf Weekday(dtDate) = 7 Then
        GetNearestStockDay = dtDate - 1
    Else
        GetNearestStockDay = dtDate
    End If
    End Function