Please help me i used this code from net but when i click download data neither giving error nor data
VBA Code:
Sub GetData()
Dim QuerySheet As Worksheet
Dim DataSheet As Worksheet
Dim Symbol As String
Dim startDate As String
Dim endDate As String
Dim period As String
Dim last As Double
Dim OffsetCounter As Double
Dim crumb As String
Dim cookie As String
Dim validCookieCrumb As Boolean
Dim qurl As String
Dim nQuery As Name
Dim i As Integer, N As Integer, pct As Double
Application.ScreenUpdating = True
Application.DisplayAlerts = False
Application.Calculation = xlCalculationAutomatic
Set QuerySheet = Sheets("Download")
Set DataSheet = Sheets("Calculations")
N = Range("C1")
Clear ' clear old data
Init ' paste headings
' ----------------------------------
For i = 1 To N
Range("A1") = i
Range("B4") = Cells(i + 7, 1) ' get symbol
Cells(i + 7, 1).Select
Application.ScreenUpdating = False
Range("K5:AE5").Select ' collect calculations
Selection.Copy
Sheets("Calculations").Select ' move to Calculations sheet
Cells(i + 7, 3).Select ' select proper row and paste calculations
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Download").Select ' move to Data sheet
Application.ScreenUpdating = True
Next i
Range("A1").Select
Selection.ClearContents
Sheets("Calculations").Select
GetNames
Formats
Range("C1").Select
startDate = DataSheet.Range("B2").Value
endDate = DataSheet.Range("B3").Value
Symbol = DataSheet.Range("B4").Value
Range("C7").CurrentRegion.ClearContents
period = "1d"
' Period
If QuerySheet.Range("B3") = "Daily" Then
period = "1d"
ElseIf QuerySheet.Range("B3") = "Weekly" Then
period = "1wk"
ElseIf QuerySheet.Range("B3") = "Monthly" Then
period = "1mo"
End If
Call getCookieCrumb(crumb, cookie, validCookieCrumb)
DataSheet.Range("A8:HI600").ClearContents
'Loop over multiple symbols
For i = 8 To last
Symbol = QuerySheet.Range("A" & i).Value
OffsetCounter = 1
Call ExtractData(Symbol, startDate, endDate, period, cookie, crumb, OffsetCounter)
Next i
DataSheet.Columns("A:H").AutoFit
Application.Calculation = xlCalculationAutomatic
QuerySheet.Select
End Sub
Sub getCookieCrumb(crumb As String, cookie As String, validCookieCrumb As Boolean)
Dim i As Integer
Dim str As String
Dim crumbStartPos As Long
Dim crumbEndPos As Long
Dim objRequest
validCookieCrumb = False
For i = 0 To 5
Set objRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
With objRequest
.Open "GET", "[URL='https://finance.yahoo.com/lookup?s=bananas']Symbol Lookup from Yahoo Finance[/URL]", 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
crumb = Mid(.ResponseText, crumbStartPos, crumbEndPos - crumbStartPos)
End With
If Len(crumb) = 11 Then
validCookieCrumb = True
Exit For
End If:
Next i
'turn calculation back on
Application.DisplayAlerts = True
Range("C8:I600").Select
Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
RemoveNames
Range("A1").Select
End Sub
Sub ExtractData(Symbols As String, startDate As String, endDate As String, period As String, cookie As String, crumb As String, OffsetCounter As Double)
Dim resultFromYahoo As String
Dim objRequest
Dim csv_rows() As String
Dim resultArray As Variant
Dim nColumns As Integer
Dim iRows As Integer
Dim CSV_Fields As Variant
Dim iCols As Integer
Dim tickerURL As String
tickerURL = "[URL]https://query1.finance.yahoo.com/v7/finance/download/[/URL]" & Symbols & _
"?period1=" & startDate & _
"&period2=" & endDate & _
"&interval=" & period & "&events=history" & "&crumb=" & crumb
Set objRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
With objRequest
.Open "GET", tickerURL, False
' .setRequestHeader "Cookie", cookie
.send
.waitForResponse
resultFromYahoo = .ResponseText
End With
End Sub
Sub RemoveNames()
Dim nQuery As Name
For Each nQuery In Names
If IsNumeric(Right(nQuery.Name, 1)) Then
nQuery.Delete
End If
Next nQuery
End Sub
Sub Clear()
'
' Clear Macro
' Macro recorded 8/13/2006 by Ponzo
Sheets("Calculations").Select ' move to Calculations sheet
Range("A8:AE600").Select ' CLEAR OLD STUFF
Selection.ClearContents
Formats
Sheets("Download").Select ' move back
End Sub
Sub Move()
'
' Move Macro
' Macro recorded 09/03/2007 by pjPonzo
'
Range("C7:C600").Select
Selection.Copy
Range("K7").Select
ActiveSheet.Paste
Range("I7:I600").Select
Selection.Copy
Range("L7").Select
ActiveSheet.Paste
End Sub
Sub Init()
'
' Init Macro
' Macro recorded 09/03/2007 by pjPonzo
'
'
Range("K3:AE4").Select
Selection.Copy
Sheets("Calculations").Select
Range("C5").Select
ActiveSheet.Paste
Sheets("Download").Select
End Sub
Sub GetNames()
Dim QuerySheet As Worksheet
Dim DataSheet As Worksheet
Dim qurl As String
Dim i As Integer
Sheets("Calculations").Select
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
' Set DataSheet = ActiveSheet
Range("A8").CurrentRegion.ClearContents
'turn calculation back on
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Columns("A:A").Select
Selection.ColumnWidth = 20
End Sub
Sub Formats()
'
' Formats Macro
' Macro recorded 9/5/2008 by pjPonzo
'
'
Range("D8:Z8").Select
Selection.Copy
Range("D9:Z600").Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
Selection.ClearContents
End SubAttachments
Last edited by a moderator:
