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 Long) As Long
Sub DownloadData()
Dim URL As String, LocalFile As String, Symbol As String, lngRetVal As Long, StartDate As Date, EndDate As Date
On Error Goto ErrHdl
Symbol = Range("Symbol")
StartDate = Year(DateAdd("y", -23, Date)) 'Going 23 years back
EndDate = Year(Date)
URL = "http://ichart.finance.yahoo.com/table.csv?s=" & Symbol & "&a=2&b=13&c=" & _
StartDate & "&d=4&e=24&f=" & EndDate & "&g=d&ignore=.csv"
LocalFile = ThisWorkbook.Path & "" & Symbol & Format(Now, "mmddyyyyhhmmss") & ".csv"
lngRetVal = URLDownloadToFile(0, URL, LocalFile, 0, 0)
If lngRetVal <> 0 Or Len(Dir(LocalFile)) = 0 Then
MsgBox Symbol & " Historical Data Download Failed ...", vbCritical, "Download Data"
Else
Application.ScreenUpdating = False
With Range(Range("Symbol").Offset(2, 0), Range("Symbol").Offset(Rows.Count - Range("Symbol").Row, 6))
.MergeCells = False
.ClearContents
Workbooks.Open LocalFile, 0, True
Range(Range("A1"), Range("G1").End(xlDown)).Copy
ThisWorkbook.Activate
.Range("A1").PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
Workbooks(Dir(LocalFile)).Close False
Kill LocalFile
End If
ErrHdl:
If Not Application.ScreenUpdating Then Application.ScreenUpdating = True
If Err.Number Then MsgBox Symbol & " Historical Data Download Failed: " & Err.Description, vbCritical, "Download Data"
End Sub
