Сеть, в которой я просматриваю, имеет несколько страниц. Я хочу нажать на эти элементы или поиграть с URL-адресами и, таким образом, иметь возможность копировать данные. Начальный URL-адрес заканчивается на = 1 & playerType = ALL & ts = 1558502019375, в моем коде есть цикл, который должен идти страница за страницей, чтобы получить данные, но я не могу это сделать.

Sub UPDATE_DATA_MLB()
Application.ScreenUpdating = False

'dimension (set aside memory for) our variables
Dim objIE As InternetExplorer
Dim ele As Object
Dim y As Integer
Dim EstaPagina As Byte
Dim EstaURL As String


'Página inicial

EstaPagina = 1
'we will output data to excel, starting on row 1
y = 1

EstaURL = "http://mlb.mlb.com/stats/sortable.jsp#elem=%5Bobject+Object%5D&tab_level=child&click_text=Sortable+Player+hitting&game_type='R'&season=2018&season_type=ANY&league_code='MLB'&sectionType=sp&statType=hitting&page=1&playerType=ALL&ts=1558502019375" '&ts=1526432697176"

'start a new browser instance
Set objIE = New InternetExplorer
'make browser visible
objIE.Visible = False

Do Until EstaPagina = 255
  'navigate to page with needed data
  objIE.navigate EstaURL & EstaPagina
  'wait for page to load
  Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop

  'If UCase(Left(EstaURL, 211) & "1") = UCase(Left(objIE.LocationURL, (211 + Len(EstaPagina)))) And y > 1 Then Exit Do

  '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("datagrid").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("Sheet1").Range("A" & y).Value = ele.Children(0).textContent
      'put text of 2nd 'td' in col B
      Sheets("Sheet1").Range("B" & y).Value = ele.Children(1).textContent
      'put text of 3rd 'td' in col C
      Sheets("Sheet1").Range("C" & y).Value = ele.Children(2).textContent
      'put text of 4th 'td' in col D
      Sheets("Sheet1").Range("D" & y).Value = ele.Children(5).textContent
      'put text of 4th 'td' in col f
      Sheets("Sheet1").Range("E" & y).Value = ele.Children(22).textContent
      'increment row counter by 1
      y = y + 1
  Next
EstaPagina = EstaPagina + 1
Loop
lobjIE.Quit
Set objIE = Nothing
Set ele = Nothing

Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), _
  Header:=xlNo


Application.ScreenUpdating = True

MsgBox "Volcado terminado", vbInformation
Range("A1").Select

  'save the Excel workbook
  ActiveWorkbook.Save
End Sub ```
-2
Yunior Cruz 22 Май 2019 в 07:43

2 ответа

Лучший ответ

XMLHTTP :

Страница выполняет ajax-вызовы, чтобы получить json, который она использует для обновления содержимого каждой страницы. Это делается с использованием параметров строки запроса, одним из которых является количество записей на странице (по умолчанию 50). Вы можете просмотреть это действие на вкладке сети браузера с помощью инструментов разработчика F12

enter image description here

Вы можете избежать использования браузера и отправлять запросы xmlhttp к одной и той же конечной точке, изменяя параметры строки запроса, чтобы получить все результаты. Кажется, в моем тестировании вы не можете запросить все результаты за один раз. Вместо этого я отправляю запрос на 1000 результатов, затем проверяю, есть ли какие-либо дополнительные результаты для получения, и отправляю дополнительные запросы, партиями по 1000, чтобы получить их.

Я использую jsonconverter.bas для анализа json , Я извлекаю информацию из json и загружаю в массив results, так что я могу записать все результаты на лист за один раз - гораздо более эффективный способ, так как уменьшает ввод / вывод с листа.

После копирования кода из приведенной выше ссылки в модуль с именем jsonConverter, вам нужно перейти в «VBE> Инструменты> Ссылки> Добавить ссылку на Microsoft Scripting Runtime».


ЗАДАЧИ:

  1. Добавить обработку ошибок для неудачного запроса

< Сильный > VBA :

Option Explicit  
Public Sub GetResults()
    'VBE > Tools > References > Microsoft Scripting Runtime
    Dim ws As Worksheet, results(), i As Long, totalResults As Long
    Dim headers(), columnCount As Long, pageNumber As Long
    Dim numberOfPages As Long, resultsPerPage As Long, json As Object

    resultsPerPage = 1000
    pageNumber = 1
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    With CreateObject("MSXML2.XMLHTTP")

        .Open "GET", "http://mlb.mlb.com/pubajax/wf/flow/stats.splayer?season=2018&sort_order=%27desc%27&sort_column=%27avg%27&stat_type=hitting&page_type=SortablePlayer&game_type=%27R%27&player_pool=ALL&season_type=ANY&sport_code=%27mlb%27&results=" & resultsPerPage & "&recSP=" & pageNumber & "&recPP=" & resultsPerPage, False
        .send

        Set json = JsonConverter.ParseJson(.responseText)
        totalResults = json("stats_sortable_player")("queryResults")("totalSize")
        headers = json("stats_sortable_player")("queryResults")("row").item(1).keys
        numberOfPages = json("stats_sortable_player")("queryResults")("totalP")
        columnCount = UBound(headers) + 1

        ReDim results(1 To totalResults, 1 To columnCount)
        Dim r As Long, c As Long, dict As Object, key As Variant

        For pageNumber = 1 To numberOfPages
            If pageNumber > 1 Then
                .Open "GET", "http://mlb.mlb.com/pubajax/wf/flow/stats.splayer?season=2018&sort_order=%27desc%27&sort_column=%27avg%27&stat_type=hitting&page_type=SortablePlayer&game_type=%27R%27&player_pool=ALL&season_type=ANY&sport_code=%27mlb%27&results=" & resultsPerPage & "&recSP=" & pageNumber & "&recPP=" & resultsPerPage, False
                .send
                Set json = JsonConverter.ParseJson(.responseText)
            End If

            For Each dict In json("stats_sortable_player")("queryResults")("row")
                r = r + 1: c = 1
                For Each key In dict.keys
                    results(r, c) = dict(key)
                    c = c + 1
                Next
            Next
        Next
    End With
    With ws
        .Cells(1, 1).Resize(1, columnCount) = headers
        .Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
    End With
End Sub

Пример вывода (спасибо, что не могу читать как есть, но идея макета):

Ссылка на изображение: https://i.stack.imgur.com/jiDTP.png


Internet Explorer:

Если вы хотите использовать более медленное браузерное решение, вы можете объединить номер страницы в URL и цикл, чтобы охватить все страницы. Количество страниц можно извлечь из нумерации страниц на странице 1.

Вы можете узнать, как писать таблицы под друг другом, посмотрев этот ответ. Измените строки с GetLastRow(ws, 1) + 2 на GetLastRow(ws, 1) + 1

Option Explicit
'VBE > Tools > References: Microsoft Internet Controls

    Public Sub GetData()
        Dim ie As New InternetExplorer, numberOfPages As Long
        Dim url As String, i As Long
        Const PLAYERS_PER_PAGE = 50
        url = "http://mlb.mlb.com/stats/sortable.jsp#elem=%5Bobject+Object%5D&tab_level=child&click_text=Sortable+Player+hitting&game_type='R'&season=2018&season_type=ANY&league_code='MLB'&sectionType=sp&statType=hitting&page=1&playerType=ALL&ts="

        With ie
            .Visible = True
            .Navigate2 url
            While .Busy Or .readyState < 4: DoEvents: Wend

            With .document

                numberOfPages = CLng(.querySelector(".paginationWidget-last").innerText)

                'do something  with page 1
                If numberOfPages > 1 Then

                    For i = 2 To numberOfPages
                        ie.Navigate2 Replace$(url, "page=1", "page=" & CStr(i))
                        While ie.Busy Or ie.readyState < 4: DoEvents: Wend

                        'do something with other pages
                    Next
                    Stop 'delete me later
                End If  
            End With  
            .Quit
        End With
    End Sub
0
QHarr 22 Май 2019 в 17:01

Мне удалось дополнить его второй код своим, хотя я не был очень профессионалом, меня интересует, как добиться combertir по URL-адресу "официальная страница для jsone"

 Option Explicit
   'VBE > Tools > References: Microsoft Internet Controls

Public Sub GetData()

Dim ele As Object
Dim y As Integer
Dim EstaPagina As Byte
EstaPagina = 1
'we will output data to excel, starting on row 1
y = 1
Dim ie As New InternetExplorer, numberOfPages As Long
Dim url As String, i As Long
Const PLAYERS_PER_PAGE = 50
url = "http://mlb.mlb.com/stats/sortable.jsp#elem=%5Bobject+Object%5D&tab_level=child&click_text=Sortable+Player+pitching&game_type='R'&season=2018&season_type=ANY&league_code='MLB'&sectionType=sp&statType=pitching&page=1&playerType=ALL&ts="

        With ie
            .Visible = True
            .Navigate2 url
            While .Busy Or .readyState < 4: DoEvents: Wend
            With .document
                numberOfPages = CLng(.querySelector(".paginationWidget-last").innerText)

                'do something  with page 1
                If numberOfPages > 1 Then

                    For i = 1 To numberOfPages
                        ie.Navigate2 Replace$(url, "page=1", "page=" & CStr(i))

                        For Each ele In ie.document.getElementById("datagrid").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("Sheet1").Range("A" & y).value = ele.Children(1).textContent
        'put text of 2nd 'td' in col B
        Sheets("Sheet1").Range("B" & y).value = ele.Children(2).textContent
        'put text of 3rd 'td' in col C
        Sheets("Sheet1").Range("C" & y).value = ele.Children(3).textContent
        'put text of 4th 'td' in col D
        Sheets("Sheet1").Range("D" & y).value = ele.Children(4).textContent
        'put text of 4th 'td' in col f
        Sheets("Sheet1").Range("E" & y).value = ele.Children(5).textContent
        'increment row counter by 1
        y = y + 1
        Next
        While ie.Busy Or ie.readyState < 4: DoEvents: Wend
  ' do something with other pages
                    Next
   ' Stop 'delete me later
                End If
            End With
            .Quit
        End With
        On Error Resume Next
        Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.RemoveDuplicates Columns:=Array(1, 2, 3, 4), _
    header:=xlNo

On Error Resume Next
Application.ScreenUpdating = True

MsgBox "Volcado terminado", vbInformation
Range("A1").Select

    'save the Excel workbook
    ActiveWorkbook.Save


    End Sub
0
Yunior Cruz 23 Май 2019 в 19:51