VBA code works sometimes, the breaks at other times. Am I missing something in this Code? [closed]

StackOverflow https://stackoverflow.com/questions/21844615

  •  13-10-2022
  •  | 
  •  

Question

Thank you in advance for the help.

When I run tickers through the code it stops. This is pulling mutual fund data, so if you want to test the code yourself...I would Use(INDZX, CULAX, ABRZX, TAGBX, PRPFX (Don't use these Mutual funds, they are no good; just for an example)). I literally have to sit by my computer and erase the tickers where the data has already been pulled over so that it can start over again; very time consuming.

Can one of you please help me out.

Let me know if you have further questions on this.

Just to add when it completely breaks, and look at the debug, it highlights the "Do While IE.readystate<> 4: DoEvents: Loop

The other issue I am having is that when there are no tickers left, the code continues to run. 

Sub upDown()

Dim IE As Object, Doc As Object, lastRow As Long, tblTR As Object, tblTD As Object,  
strCode As String
lastRow = Range("H65000").End(xlUp).Row


Set IE = CreateObject("internetexplorer.application")
IE.Visible = True


last_row = Sheets("Tickers").Range("H1").End(xlDown).Row

ini_row_dest = 1

Sheets("upDown").Select

Sheets("upDown").Range("A1:m10000").ClearContents

Application.ScreenUpdating = True






     For i = 1 To lastRow
    Application.StatusBar = "Updating upDown" & i & "/" & last_row

    row_dest = ini_row_dest + (i - 1)

    strCode = "Tickers"    ' Range("A" & i).value  
    list_symbol = Sheets("Tickers").Range("h" & i)
    IE.navigate "http://performance.morningstar.com/fund/ratings-risk.action?t=" & list_symbol

    Do While IE.readystate <> 4: DoEvents: Loop

    Set Doc = CreateObject("htmlfile")
    Set Doc = IE.document

    tryAgain:

    Set tblTR = Doc.getelementbyid("div_upDownsidecapture").getelementsbytagname("tr")(3)

    If tblTR Is Nothing Then GoTo tryAgain
    On Error Resume Next



    j = 2
    For Each tblTD In tblTR.getelementsbytagname("td")
        tdVal = Split(tblTD.innerText, vbCrLf)
        Cells(i, j) = tdVal(0)
        Cells(i, j + 1) = tdVal(1)
        j = j + 2



     Next

    Sheets("upDown").Range("A" & row_dest).Value = list_symbol
     Next i

    Range("A3").Select

    Application.StatusBar = False

    Application.Calculation = xlAutomatic


    End Sub
Was it helpful?

Solution

From your description, when it's 'stuck' you press CTRL-Break, and it stops at

 Do While IE.readystate<> 4: DoEvents: Loop

This means that IE is busy. You should probably work out why. What happens if you switch to the IE window? Maybe it has a popup? It's entirely likely that morningstar.com has detected that you are scraping data and is halting it. Normally you need to pay some kind of a subscription to get this kind of thing.

Anyway what you could do is put in a 'watchdog' that detects this state and tries to recover. Here is some code below but it is basically a hack and I don't quite understand how your row index is meant to work. The code below uses Goto which is just a lazy way of doing things but it is certainly no worse than the existing code.

Anyway try it and see. What you might find is that the IE.Quit line might prompt you to close IE, but at least it can restart from where it failed and you don't need to clear the tickers out and start again.

An alternative solution might be to save the half finished workbook and alter the code to pick up from where it left off based on which tickers have data and which don't

Sub upDown()

Dim IE As Object, Doc As Object, lastRow As Long, tblTR As Object, tblTD As Object,  
strCode As String
Dim iWatchDog as Integer
iWatchDog = 1

lastRow = Range("H65000").End(xlUp).Row
ini_row_dest = 1
Sheets("upDown").Select
Sheets("upDown").Range("A1:m10000").ClearContents

Start:
Set IE = CreateObject("internetexplorer.application")
IE.Visible = True

last_row = Sheets("Tickers").Range("H1").End(xlDown).Row


Application.ScreenUpdating = True






For i = 1 To lastRow
Application.StatusBar = "Updating upDown" & i & "/" & last_row

row_dest = ini_row_dest + (i - 1)

strCode = "Tickers"    ' Range("A" & i).value  
list_symbol = Sheets("Tickers").Range("h" & i)
IE.navigate "http://performance.morningstar.com/fund/ratings-risk.action?t=" &     list_symbol

Do While IE.readystate <> 4
    DoEvents
    DoEvents
    DoEvents
    DoEvents
    DoEvents
    iWatchDog = iWatchDog + 1
    If iWatchDog >= 10000 Then 
        Application.StatusBar = "Stuck - resetting"
        iWatchDog = 1
        IE.Stop
        IE.Quit
        Set IE = Nothing
        DoEvents
        DoEvents
        DoEvents
        DoEvents
        Goto Start
    End If
Loop


Set Doc = CreateObject("htmlfile")
Set Doc = IE.document

tryAgain:

Set tblTR = Doc.getelementbyid("div_upDownsidecapture").getelementsbytagname("tr")(3)

If tblTR Is Nothing Then GoTo tryAgain
On Error Resume Next



j = 2
For Each tblTD In tblTR.getelementsbytagname("td")
    tdVal = Split(tblTD.innerText, vbCrLf)
    Cells(i, j) = tdVal(0)
    Cells(i, j + 1) = tdVal(1)
    j = j + 2
Next

Sheets("upDown").Range("A" & row_dest).Value = list_symbol
 Next i

Range("A3").Select

Application.StatusBar = False

Application.Calculation = xlAutomatic


End Sub

Where is this 3,800 lines of ticker data eventually going? into a database or is it fed into another Excel sheet?

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top