VBA - HTML Pull Data

jamescooper

Well-known Member
Joined
Sep 8, 2014
Messages
840
The following code is only pulling 1 result when there should be 6 results, can anyone spot where the code is overwriting rather than adding to it?

Many thanks.

Code:
Sub Meeting_List()
  
  Dim IE As InternetExplorer
  Set IE = New InternetExplorer
  Dim ElementCol As Object
  Dim Link As Object
  Dim erow As Long
 
  With IE
  .navigate Sheet2.Range("A1")
  .Visible = True
  Do While IE.readyState <> READYSTATE_COMPLETE
  DoEvents
  Loop
  Application.Wait Now + TimeValue("00:00:03")
  End With
 
  Dim html As HTMLDocument
  Set html = IE.Document
 
  Dim ele As IHTMLElementCollection
  Dim lists As IHTMLElementCollection
  Dim row As Long
 
  Set ele = html.getElementsByTagName("a")
  For Each e In ele
      If e.className = "gh dogName" Then
          Set lists = e.getElementsByTagName("strong")
          row = 1
          For Each strong In lists
            Cells(row, 1) = strong.innerText
            row = row + 1
          Next
      End If
  Next e
  IE.Quit


End Sub
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
Hi,

if you step through the code using F8 you'll see that on reaching 'Next e that the code jumps to the If e.classname line.
Thus row=1 will always be true on each loop.
The variable initialising needs to be outside the loop. I would put it in front of the For Each line.
 
Last edited:
Upvote 0
Hello Dave,

Thanks for the reply. I have managed to get this to work.

I have another query though if thats OK. This code works to pull table data and put it into excel. I am just struggling to insert the second result below the first, it is overwriting it. Any ideas. Need somehow to find the next blank row.

Many thanks.

Code:
Sub History()
 
    'dimension (set aside memory for) our variables
    Dim objIE As InternetExplorer
    Dim ele As Object
    Dim y As Integer
    Dim DLine As Range
    
    For Each DLine In Sheet6.Range("A1:A" & Sheet6.Range("B1"))
    Set objIE = CreateObject("InternetExplorer.Application")
    With objIE
    .Navigate DLine.Value
    .Visible = True
    Do While objIE.ReadyState <> READYSTATE_COMPLETE
    DoEvents
    Loop
    Application.Wait Now + TimeValue("00:00:03")
    End With
    
    'we will output data to excel, starting on row 1
    y = 1
 
   row = Cells(Rows.Count, "A").End(xlUp).row
   row = IIf(row = 1 And IsEmpty(Cells(1, 1)), 1, row + 1)
 
    'look at all the 'tr' elements in the 'table' with id 'myTable',
    'and evaluate each, one at a time, using 'ele' variable
    For Each ele In objIE.Document.getElementById("sortableTable").getElementsByTagName("tr")
        'show the text content of 'tr' element being looked at
        Debug.Print ele.textContent
        'each 'tr' (table row) element contains 4 children ('td') elements
        'put text of 1st 'td' in col A
        Sheets("Sheet5").Range("A" & y).Value = ele.Children(0).textContent
        'put text of 2nd 'td' in col B
        Sheets("Sheet5").Range("B" & y).Value = ele.Children(1).textContent
        'put text of 3rd 'td' in col C
        Sheets("Sheet5").Range("C" & y).Value = ele.Children(2).textContent
        'put text of 4th 'td' in col D
        Sheets("Sheet5").Range("D" & y).Value = ele.Children(3).textContent
        'put text of 5th 'td' in col E
        Sheets("Sheet5").Range("E" & y).Value = ele.Children(4).textContent
        'put text of 6th 'td' in col F
        Sheets("Sheet5").Range("F" & y).Value = ele.Children(5).textContent
        'put text of 7th 'td' in col G
        Sheets("Sheet5").Range("G" & y).Value = ele.Children(6).textContent
        'put text of 8th 'td' in col H
        Sheets("Sheet5").Range("H" & y).Value = ele.Children(7).textContent
        'put text of 9th 'td' in col I
        Sheets("Sheet5").Range("I" & y).Value = ele.Children(8).textContent
        'put text of 10th 'td' in col J
        Sheets("Sheet5").Range("J" & y).Value = ele.Children(9).textContent
        'put text of 11th 'td' in col K
        Sheets("Sheet5").Range("K" & y).Value = ele.Children(10).textContent
        'put text of 12th 'td' in col L
        Sheets("Sheet5").Range("L" & y).Value = ele.Children(11).textContent
        'put text of 13th 'td' in col M
        Sheets("Sheet5").Range("M" & y).Value = ele.Children(12).textContent
        'put text of 14th 'td' in col N
        Sheets("Sheet5").Range("N" & y).Value = ele.Children(13).textContent
        'put text of 15th 'td' in col O
        Sheets("Sheet5").Range("O" & y).Value = ele.Children(14).textContent
        
        'increment row counter by 1
        y = y + 1
    'repeat until last ele has been evaluated
    Next
      objIE.Quit
  Set objIE = Nothing
    Next DLine
 
End Sub
 
Upvote 0
The code has changed from the previous but again it's the position of the loop counter that appears to be your issue.
For each DLine (URL) the code runs through y will count through the inner loop values of each ele A to O so y will always be between 1 and 15.

Using F8 to step through your code and hover over the y value each time the yellow marker line passes the y=y+1 code line you will see the value count 1 to 15 then start again at 1 on the next DLine and overwrite the previous 15 lines.

y needs to be on the outer loop so it retains '15' as the starting point for the next loop.
It needs to be placed before 'For Each DLine'
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,289
Members
452,631
Latest member
a_potato

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top