Background of my code: More or less what my code does is take a series of stock ticker symbols and fetches historical data from Yahoo finance.
Problem: I keep getting a System Error &H80004005 (-2147467259). Unspecified error. I really only get this after about 23 loops (23 ticker symbols).
I have looked everywhere trying to fix this code but cannot resolve it for my life. I've tried different computers, changing what I though were problem lines, everything.
I would attach my workbook, but I have no idea how.
Here is my code:
Problem: I keep getting a System Error &H80004005 (-2147467259). Unspecified error. I really only get this after about 23 loops (23 ticker symbols).
I have looked everywhere trying to fix this code but cannot resolve it for my life. I've tried different computers, changing what I though were problem lines, everything.
I would attach my workbook, but I have no idea how.
Here is my code:
Code:
'Need reference to Microsoft HTML Object Library (Tools - References)
Sub Test()
' Deletes any excess worksheets, clears B8:B30, and unbolds cells
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In Worksheets
If ws.Name <> "Sheet1" And ws.Name <> "Sheet2" And ws.Name <> "Misc" And ws.Name <> "RSI" Then ws.Delete
Next
Application.DisplayAlerts = True
Worksheets("sheet2").Cells.Range("b8:b30").ClearContents
Worksheets("sheet2").Cells.Range("a34:p56").Font.Bold = False
Worksheets("Sheet2").Range("a1").Select
' disables screen updating
Application.ScreenUpdating = False
Dim c As Object
For Each c In Worksheets("sheet2").Cells.Range("b34:P56")
If c > 1 Then
Dim ie As Object
Dim doc As HTMLDocument
Dim links As IHTMLElementCollection
Dim link As HTMLAnchorElement
Dim i As Integer
Dim found As Boolean
Dim todaysURL As String
Set ie = CreateObject("InternetExplorer.Application")
' To not show windows make ie.visible = false. Also, concatenate the webpage by ie.navigate "http://finance.yeahoo.com/q/hp?s="
' & "ticker symbol" & "+historical+prices"
ie.Visible = False
Sheets.Add.Name = "active"
ie.navigate "http://finance.yahoo.com/q/hp?s=" & c & "+Historical+Prices"
Do Until ie.readyState = IE_READYSTATE.complete: DoEvents: Loop
' This enteres parameters for dates. 00 = january, 11 = december
' This if statement makes sure there is a leading 0 when needed (month)
If Cells.Range("D3:D3") > 9.99 Then
ie.document.getelementbyid("selstart").Value = Cells.Range("D3:D3")
Else: ie.document.getelementbyid("selstart").Value = "0" & Cells.Range("D3:D3")
End If
' This if statement makes sure there is a leading 0 when needed (days)
If Cells.Range("d4:d4") > 9.99 Then
ie.document.getelementbyid("startday").Value = Cells.Range("d4:d4")
Else: ie.document.getelementbyid("startday").Value = "0" & Cells.Range("d4:d4")
End If
'enters starting year
ie.document.getelementbyid("startyear").Value = Cells.Range("d5:d5")
'Enters end month
If Cells.Range("g3:g3") > 9.99 Then
ie.document.getelementbyid("selend").Value = Cells.Range("g3:g3")
Else: ie.document.getelementbyid("selend").Value = "0" & Cells.Range("g3:g3")
End If
'Enters end day
If Cells.Range("g4:g4") > 9.99 Then
ie.document.getelementbyid("endday").Value = Cells.Range("g4:g4")
Else: ie.document.getelementbyid("endday").Value = "0" & Cells.Range("g4:g4")
End If
'Enters end year
ie.document.getelementbyid("endyear").Value = Cells.Range("g5:g5")
'Submits search
ie.document.forms(3).submit
Do Until ie.readyState = IE_READYSTATE.complete: DoEvents: Loop
'this pauses the application for 3 seconds (might be too long)
Application.Wait Now + TimeValue("00:00:03")
'taken from http://www.mrexcel.com/forum/showthread.php?t=302438
'Finds correct link to download .cvs historical data
Set doc = ie.document
'Get all links ( < A > tags)
Set links = doc.getElementsByTagName("A")
found = False
i = 0
While i < links.Length And Not found
i = i + 1
Set link = links(i)
If InStr(link.href, "http://ichart.finance.yahoo.com/table.csv?") Then
found = True
todaysURL = link.href
End If
Wend
If found Then
'open the csv table
Workbooks.Open todaysURL
'save the csv table as lolol
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\Miller\desktop\lolol.csv", FileFormat:=xlCSV, _
CreateBackup:=False
' copy the range
ActiveSheet.Cells.Range("a:g").Copy
'says no to the stupid clipboard popup
Application.DisplayAlerts = False
'pastes into the correct sheet
Windows("Future RSI Chart Codes.xlsm").Activate
ActiveSheet.Paste
'close and delete csv window
Windows("lolol.csv").Activate
ActiveWorkbook.Close savechanges:=False
Kill "C:\Users\Miller\desktop\lolol.csv"
'Sort active sheet and copy
ActiveWorkbook.Worksheets("active").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("active").Sort.SortFields.Add Key:=Range("A2:A151") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("active").Sort
.SetRange Range("A1:G164")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.Copy
' Copy RSI sheet, paste data from active sheet to RSI (2)
Sheets("RSI").Select
Sheets("RSI").Copy After:=Sheets(5)
Sheets("active").Cells.Range("a2:g164").Copy
Sheets("RSI (2)").Cells.Range("a32").Select
ActiveCell.PasteSpecial
' If RSI less than 23 it gets pasted into the next blank cell of B8:B30
Dim d As Object
For Each d In Worksheets("sheet2").Cells.Range("B8:b30")
If Sheets("RSI (2)").Cells.Range("L194") < 23 Then
If d = "" Then
Worksheets("Sheet2").Activate
c.Select
Selection.Copy
d.PasteSpecial
If d.Offset(-1, 0) = d Then
d.ClearContents
End If
If d.Offset(-1, 0) = "" Then
d.ClearContents
End If
End If
End If
Next d
' Delets RSI 2 and active sheet if RSI is greater than 23
If Sheets("RSI (2)").Cells.Range("L194") > 23 Then
Sheets("RSI (2)").Delete
Worksheets("active").Delete
Else
Worksheets("RSI (2)").Activate
ActiveSheet.Name = c & " RSI"
Application.DisplayAlerts = False
Worksheets("active").Delete
Application.DisplayAlerts = True
End If
End If
Else: c = ""
End If
'sledgehammer approach to closing ALL ie windows.
'http://www.mrexcel.com/forum/showthread.php?t=229394
'Dim objWMI As Object, objProcess As Object, objProcesses As Object
' Set objWMI = GetObject("winmgmts://.")
'Set objProcesses = objWMI.ExecQuery( _
' "SELECT * FROM Win32_Process WHERE Name = 'iexplore.exe'")
' For Each objProcess In objProcesses
' Call objProcess.Terminate
' Next
' Set objProcesses = Nothing: Set objWMI = Nothing
c.Font.Bold = True
Next
Worksheets("sheet2").Activate
Application.ScreenUpdating = True
'sledgehammer approach to closing ALL ie windows.
'http://www.mrexcel.com/forum/showthread.php?t=229394
'Dim objWMI As Object, objProcess As Object, objProcesses As Object
'Set objWMI = GetObject("winmgmts://.")
' Set objProcesses = objWMI.ExecQuery( _
' "SELECT * FROM Win32_Process WHERE Name = 'iexplore.exe'")
' For Each objProcess In objProcesses
' Call objProcess.Terminate
' Next
' Set objProcesses = Nothing: Set objWMI = Nothing
End Sub
