2016-08-15 8 views
0

Я пытаюсь сделать макрос, чтобы очистить таблицу фэнтезийных футбольных проекций от ESPN. У меня есть код для работы с очисткой данных, но я не смог понять, как выполнять итерацию через различные версии URL-адреса, которые мне нужны для захвата данных из ничего, кроме первой страницы.Looping Web Scraping VBA Macro

URL-адрес является: "http://games.espn.com/ffl/tools/projections?&seasonTotals=true&seasonId=2016&slotCategoryId=0&startIndex=0"

мне нужно перебирать значения для "slotCategoryID = 0" и "STARTINDEX = 0". Каждый раз, загружая веб-страницу, копируя данные и добавляя их в таблицу в excel.

slotCategoryID представляет позицию игрока, и должны перебирать значения 0,2,4,6,16, & 17.

STARTINDEX просто продвигает страницу. Это 0 для стр. 1, 40 для стр. 2, 80 для стр. 3 и т. Д.

Пожалуйста, помогите!

Вот код, который я до сих пор, который работает, чтобы скопировать данные таблицы сразу:

Sub extractTablesData() 
'we define the essential variables 

Dim IE As Object 
Dim r As Integer, c As Integer, t As Integer, pos As Integer 
Dim elemCollection As Object 


'---- 
     'add the "Microsoft Internet Controls" reference in your VBA Project indirectly 
     Set IE = CreateObject("InternetExplorer.Application") 



     With IE 
     .Visible = True 
     .navigate "http://games.espn.com/ffl/tools/projections?&seasonTotals=true&seasonId=2016&slotCategoryId=0&startIndex=0" 

     ' we ensure that the web page downloads completely before we fill the form automatically 
     While IE.ReadyState <> 4 
     DoEvents 
     Wend 

     ' again ensuring that the web page loads completely before we start scraping data 
     Do While IE.busy: DoEvents: Loop 

     Set elemCollection = IE.Document.getElementsByTagName("TABLE") 

      For t = 0 To (elemCollection.Length - 1) 
       For r = 1 To (elemCollection(t).Rows.Length - 1) 
        For c = 0 To (elemCollection(t).Rows(r).Cells.Length - 1) 
         ThisWorkbook.Worksheets(1).Cells(r, c + 1) = elemCollection(t).Rows(r).Cells(c).innerText 
        Next c 
       Next r 
      Next t 

     End With 
     ' cleaning up memory 
     Set IE = Nothing 

'---- 
End Sub 
+0

Вы сказали это: вам нужно итератировать. Так и сделайте это. Обновляйте строку 'navigate' с каждой итерацией. Или еще лучше, создайте подкаталог 'extractTablesData', чтобы вы могли передать любой URL-адрес, а затем выполнить итерацию с подкаталога. – Marc

ответ

0

Это должно делать то, что вы хотите !!

Sub Test() 

    Dim ie As Object 
    Dim i As Long 
    Dim strText As String 
    Dim doc As Object 
    Dim hTable As Object 
    Dim hBody As Object 
    Dim hTR As Object 
    Dim hTD As Object 
    Dim tb As Object 
    Dim bb As Object 
    Dim tr As Object 
    Dim td As Object 

    Dim y As Long, z As Long, wb As Excel.Workbook, ws As Excel.Worksheet 

    Set wb = Excel.ActiveWorkbook 
    Set ws = wb.ActiveSheet 

    Set ie = CreateObject("InternetExplorer.Application") 
    ie.Visible = True 

    y = 1 'Column A in Excel 
    z = 1 'Row 1 in Excel 
variable = 0 
Here: 

    ie.navigate "http://games.espn.com/ffl/tools/projections?&seasonTotals=true&seasonId=2016&slotCategoryId=0&startIndex=" & variable 

    Do While ie.Busy: DoEvents: Loop 
    Do While ie.ReadyState <> 4: DoEvents: Loop 

    Set doc = ie.document 
    Set hTable = doc.getElementsByClassName("playerTableTable tableBody") 

    For Each tb In hTable 

     Set hBody = tb.getElementsByTagName("tbody") 
     For Each bb In hBody 

      Set hTR = bb.getElementsByTagName("tr") 
      For Each tr In hTR 

       Set hTD = tr.getElementsByTagName("td") 
       y = 1 ' Resets back to column A 
       For Each td In hTD 
        ws.Cells(z, y).Value = td.innerText 
        y = y + 1 
       Next td 
       DoEvents 
       z = z + 1 
      Next tr 
      Exit For 
     Next bb 
    Exit For 
    Next tb 

variable = variable + 40 
GoTo Here: 
End Sub