Need Help Getting Info from the Web - Excel WebQuery Is Too Slow

[ransomedbyfire]

I am trying to get one piece of information (the Morningstar style box classification) for each of something like 800 securities. And then use a piece of code to translate those classifications into two-letter codes. I can use the following piece of code to do this, but it is very slow and tends to freeze up Excel.

Sub MSStyleBoxes()

Sheet2.Select

'Finds the last row
lastrow = Range("a:a").Find(what:="", after:=[a13]).Row - 1

styleboxlist = TempFolder & "\MyFile.CSV"
Open styleboxlist For Output As #1

Dim symarray(1 To lastrow)
symarray = Sheet2.Range("a13:a" & lastrow)

For n = 1 To lastrow
    symbol = symarray(n)
    
    With Sheet12.QueryTables.Add(Connection:= _
        "URL;http://research.tdameritrade.com/public/mutualfunds/profile/profile.asp?symbol=" & symbol _
        , Destination:=Sheet12.Range("d" & n))
        .WebFormatting = xlWebFormattingNone
        .WebTables = """symbolHeaderTable"""
        .Refresh BackgroundQuery:=False
    End With
    
    For r = 1 To 10
        MSstring = Sheet12.Cells(r, 2)
        If InStr(1, Sheet12.Range("d3"), stylebox) Then
            Cells(Row, 11) = Sheet12.Cells(r, 2)
            GoTo NextSymbol
        End If
    Next r
    
NextSymbol:
Next Row

End Sub

I've looked into doing a more manual query like this, but it tends to return way too much information.

Sub WebTableToSheet()
  'Tested using IE7,  Excel 2000 SP1, and Windows XP
  Dim objIE As Object
  Dim varTables, varTable
  Dim varRows, varRow
  Dim varCells, varCell
  Dim lngRow As Long, lngColumn As Long
  Dim strBuffer As String
  Dim tabletext As String
  Dim mystring As String
  
  Set objIE = CreateObject("InternetExplorer.Application")
 
  With objIE
    .AddressBar = False
    .StatusBar = False
    .MenuBar = False
    .Toolbar = 0
    .Visible = False
    .Navigate "http://research.tdameritrade.com/public/mutualfunds/profile/profile.asp?symbol=vfinx"
  End With
  

  While objIE.Busy
  Wend
  While objIE.Document.ReadyState <> "complete"
  Wend
  
  Set varTables = objIE.Document.All.tags("TABLE")
  For Each varTable In varTables
    'Use the innerText to see if this is the table we want.
    tabletext = varTable.innertext
    mystring = "Prospectus"
        If InStr(1, tabletext, mystring) Then
        Set varRows = varTable.Rows
      lngRow = 2 'This will be the first output row
      For Each varRow In varRows
        Set varCells = varRow.Cells
        lngColumn = 1 'This will be the output column
        For Each varCell In varCells
          ActiveSheet.Cells(lngRow, lngColumn) = varCell.innertext
          lngColumn = lngColumn + 1
        Next varCell
        lngRow = lngRow + 1
      Next varRow
    End If
  Next varTable
  
Cleanup:
  Set varCell = Nothing: Set varCells = Nothing
  Set varRow = Nothing: Set varRows = Nothing
  Set varTable = Nothing: Set varTables = Nothing
  objIE.Quit
  Set objIE = Nothing
End Sub

Can anyone give me a better alternative?