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

662 Views Asked by At

Overview
I am using www.quandl.com free financial data to attempt to predict Asset price movements

Approach
I have built a function to download the data using the quandl API. I am declaring 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 codes works, It will download the data to the correct file destination, I am wondering if there a way to instead of downloading straight to a file location; to just run it straight to an Access DB Table? I know the function explicitly states that it downloads straight to a file, but It would be nice to have a way to go straight to Access DB. Also I know next to nothing about these api function so please take it easy

1

There are 1 best solutions below

0
On BEST ANSWER

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