Stockparser

Public Sub getgoogprice()
Dim xmlhttp As Object
Dim strURL As String
Dim Companydata As String
Dim x As String
Dim sSearch As String
Dim getgoogprice As String
Dim Watchlist As New ADODB.Connection
Dim watchlistconnect As String
 
'If the date is sunday, saturday, or a stock holiday, the program ends

If Format(DateTime.Date, "dddd") = "Sunday" Or Format(DateTime.Date, "dddd") = "Saturday" Then GoTo EndScript
 
HolidayArray = Array("12/24/10", "1/1/2011", "1/16/2011", "2/20/2011", "4/6/2011", "5/28/2011", "7/4/2011", "9/3/2011", "11/22/2011", "12/25/2011")
For y = 0 To (UBound(HolidayArray) - 1)
    If Format(HolidayArray(y), "mm/dd/yyyy") = DateTime.Date Then GoTo EndScript
Next y
 
'Connects to the database with the stocklist & stock data storage tables
watchlistconnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\stockdbs\Watchlist.accdb;Persist Security Info=False;"
Watchlist.ConnectionString = watchlistconnect
Watchlist.Open
 
'Grabs the stock symbols & splits them into arrays & strings to feed google finance

Set WatchlistArray = Watchlist.Execute("SELECT * FROM Stocklist")
With WatchlistArray
    .MoveFirst
    Do
        For Z = 1 To 14
            symbolstring = symbolstring + (!CompanyTicker & "+")
            .MoveNext
        Next Z
        fullsymbolstring = fullsymbolstring + symbolstring + "*"
        symbolstring = ""
    Loop Until .EOF
    fullsymbolstringarray = Split(fullsymbolstring, "*")
            Do
refresh:
                timeStamp = Timer
                For u = 0 To UBound(fullsymbolstringarray) - 1
 
		'Sets up the xml instance and gives it a string to feed google
		Set xmlhttp = CreateObject("msxml2.xmlhttp")
                    With xmlhttp
                        strURL = "http://www.google.com/finance?q=" & fullsymbolstringarray(u) & "&hl=en#"
                        .Open "get", strURL, False
                        .send
                        x = .responseText
                    End With
                    Set xmlhttp = Nothing
 
		'Splits up the stock string used to feed google, into individual stocks
		
		symbolarray = Split(fullsymbolstringarray(u), "+")
 
		' Parses the data related to the individual stock finds the numeric data to pull
		For w = 0 To UBound(symbolarray) - 1
                        qmarray = Chr(34) & symbolarray(w) & Chr(34)
                        x = Mid(x, InStr(1, x, qmarray) + Len(qmarray))
                        Companydata = Left(x, InStr(1, x, qmarray) + Len(qmarray))
                        cdarray = Split(Companydata, ",")
                        For t = 1 To UBound(cdarray) - 1
                            cdarray(t) = Replace(cdarray(t), Chr(34), "")
                            If IsNumeric(cdarray(t)) = True Then
 
		'Checks to see if the data matches the google finance id instead of stock price, if it does, it will then reload the data from the xml feed and try again

				Set googidselect = Watchlist.Execute("SELECT * FROM Stocklist WHERE CompanyTicker = '" & symbolarray(w) & "'")
                                googidselect.MoveFirst
                                googidnum = googidselect!GoogID
                                If cdarray(t) = CCur(googidnum) Then GoTo refresh
 
		'Inserts the stock price & current time into a database

strSQL2 = ("INSERT INTO " & symbolarray(w) & " (StockPrice, QuoteTime) VALUES (" & cdarray(t) & ", #" & DateTime.Now & "#  )")
                                Watchlist.Execute strSQL2
                                GoTo nextsymbol
                            End If
                        Next t
nextsymbol:
                    Next w
                    Set symbolarray = Nothing
                Next u
                timeelapsed = Timer - timeStamp
 
		'If the whole process took less than 6 seconds, sleep until the full 6 seconds is reached then resume            

If timeelapsed < 6 Then
                sleeptime = (6 - timeelapsed) * 1000
                Sleep (sleeptime)
            End If
            Loop Until DateTime.Time > TimeValue("16:01:00")
End With
Watchlist.Close
WatchlistArray.Close
Set WatchlistArray = Nothing
EndScript:
End Sub