-
Notifications
You must be signed in to change notification settings - Fork 1
/
Samir_Khan.bas
119 lines (101 loc) · 4.02 KB
/
Samir_Khan.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
Attribute VB_Name = "Samir_Khan"
Option Explicit
'this code was created by:
'Samir Khan
'The latest version of this spreadsheet can be downloaded from http://investexcel.net/multiple-stock-quote-downloader-for-excel/
'Please link to http://investexcel.net if you like this spreadsheet
Public crumb$
Public cookie$
Private decimalSeparator As String
Public Sub getYahooFinanceData(stockTicker$, startDate$, endDate$, _
frequency$, outDates() As Date, outTimeSeries#())
Dim resultFromYahoo$
Dim objRequest As Variant
Dim csv_rows$()
Dim iRows&
Dim CSV_Fields As Variant
Dim iCols&
Dim tickerURL$
decimalSeparator = Application.decimalSeparator
'Construct URL
'***************************************************
tickerURL = "https://query1.finance.yahoo.com/v7/finance/download/" & stockTicker & _
"?period1=" & startDate & _
"&period2=" & endDate & _
"&interval=" & frequency & "&events=history" & "&crumb=" & crumb
'***************************************************
'Get data from Yahoo
'***************************************************
Set objRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
With objRequest
.Open "GET", tickerURL, False
.setRequestHeader "Cookie", cookie
.send
.waitForResponse
resultFromYahoo = .responseText
End With
'***************************************************
'Parse returned string into an array
'***************************************************
csv_rows() = Split(resultFromYahoo, Chr(10))
ReDim outDates(UBound(csv_rows))
ReDim outTimeSeries(UBound(csv_rows), 4)
For iRows = LBound(csv_rows) + 1 To UBound(csv_rows) ' ignore first row with index 0
CSV_Fields = Split(csv_rows(iRows), ",")
outDates(iRows) = CDate(CSV_Fields(0))
For iCols = LBound(CSV_Fields) + 1 To 4
If IsNumeric(CSV_Fields(iCols)) Then
outTimeSeries(iRows, iCols) = Replace(CSV_Fields(iCols), ".", decimalSeparator)
Else
outTimeSeries(iRows, iCols) = Undefined
End If
Next
Next
End Sub
Public Function getCookieCrumb() As Boolean
Dim i&
Dim crumbStartPos&
Dim crumbEndPos&
Dim objRequest
If crumb <> "" Then
Exit Function
End If
getCookieCrumb = False
For i = 0 To 5 'ask for a valid crumb 5 times
Set objRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
With objRequest
.Open "GET", "https://finance.yahoo.com/lookup?s=bananas", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
.send
.waitForResponse (10)
cookie = Split(.getResponseHeader("Set-Cookie"), ";")(0)
crumbStartPos = InStrRev(.responseText, """crumb"":""") + 9
crumbEndPos = crumbStartPos + 11 'InStr(crumbStartPos, .ResponseText, """", vbBinaryCompare)
crumb = Mid(.responseText, crumbStartPos, crumbEndPos - crumbStartPos)
End With
If Len(crumb) = 11 Then 'a valid crumb is 11 characters long
getCookieCrumb = True
Exit For
End If:
Next i
End Function
' In time series only close price is used.
Sub ReadSharesTimeSeries(outDates_reference() As Date, outDates() As Date, inputTimeSeries#(), outTimeSeries#(), ticker$, outputLine&)
Dim i&, j&
ReDim outTimeSeries(UBound(outDates_reference))
For i = 1 To UBound(outDates)
' search for
For j = 1 To UBound(outDates_reference)
' look for the same dates:
If outDates(i) = outDates_reference(j) Then
If inputTimeSeries(i, 4) = Undefined Then
outTimeSeries(j) = Undefined
Else
outTimeSeries(j) = inputTimeSeries(i, 4)
End If
Exit For
End If
Next j
Next i
End Sub