Jump to content

Using the Yahoo finance API I am acquiring market data to fill out tables. The problem I am having is when I want to add a calculated field to both my form and my table the calculation only are applied to the first run through of the program and loops after do not get calculated again. I am new to access and to VBA so forgive the ignorance if this is just a simple fix. 

 


 

Option Compare Database
Option Explicit

Private Sub btnClearData_Click()
    CurrentDb.Execute "DELETE FROM HistQuotes", dbFailOnError
    Me.Requery
End Sub

Private Sub btnFetchData_Click()
    Const FilePathName As String = "D:\file.csv"
    Const tmpFilePathName As String = "D:\file1.csv"
    Const ForReading = 1, ForWriting = 2

    Dim oStream As Object
    Dim WinHttpReq As Object
    Dim FSO As Object
    Dim filetxt, filetxt1
    Dim myURL As String
    Dim InputString    ' As String

    '    Dim FileToWrite As String
    '    Dim InputFile As String
    '    Dim OutPutFile As String
    '    Dim Ssql As String

    Dim ticker As String
    Dim StartDay As Integer, StartMonth As Integer, StartYear As Integer
    Dim EndDay As Integer, EndMonth As Integer, EndYear As Integer

    'clear table
    CurrentDb.Execute "DELETE FROM HistQuotes", dbFailOnError
    Me.Requery
    Me.Repaint
    DoEvents
    'import symbol data ---------------------------------------------------

    ticker = Me.cboTicker
    StartDay = Day(Me.dStartDate)
    StartMonth = Month(Me.dStartDate) - 1
    StartYear = Year(Me.dStartDate)
    EndDay = Day(Me.dEndDate)
    EndMonth = Month(Me.dEndDate) - 1
    EndYear = Year(Me.dEndDate)

    myURL = "http://real-chart.finance.yahoo.com/table.csv?s=" & ticker & "&d=" & EndMonth & "&e=" & EndDay & "&f=" & EndYear & "&g=d&a=" & StartMonth & "&b=" & StartDay & "&c=" & StartYear & "&ignore=.csv"
    '    Debug.Print myURL
    Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
    WinHttpReq.SetTimeouts 60000, 60000, 60000, 60000

    WinHttpReq.Open "GET", myURL, False
    WinHttpReq.send

    myURL = WinHttpReq.responseBody
    '    Debug.Print WinHttpReq.Status
    If WinHttpReq.Status = 200 Then
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write WinHttpReq.responseBody
        oStream.SaveToFile FilePathName, 2    ' 1 = no overwrite, 2 = overwrite
        oStream.Close
    End If


    'edit CSV header ---------------------------------------------------------------
    'edit the header line. "Date", "Open" & "Close" are reserved words.

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set filetxt = FSO.OpenTextFile(FilePathName, ForReading)

    Set filetxt1 = FSO.OpenTextFile(tmpFilePathName, ForWriting, True)

    filetxt1.WriteLine ("Price_Date,Price_Open,High,Low,Price_Close,Volume,Adj_Close,Trial")
    InputString = filetxt.ReadLine

    Do While filetxt.AtEndOfStream <> True
        InputString = filetxt.ReadLine
        filetxt1.WriteLine InputString
    Loop


    filetxt.Close
    filetxt1.Close
    'end edit CSV header ---------------------------------------------------------------


    Kill FilePathName
    'rename the file
    Name tmpFilePathName As FilePathName

    DoEvents

    'import the data to the table ------------------------------------------------
    DoCmd.TransferText acImportDelim, "quoteimportspecification", "HistQuotes", FilePathName, True

    Me.Requery    'requery form
    DoEvents

    Set FSO = Nothing
    Set filetxt = Nothing
    Set WinHttpReq = Nothing

    MsgBox "Done"
End Sub

 

Link to comment
https://linustechtips.com/topic/587284-creating-new-calculated-field-in-access/
Share on other sites

Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×