невозможно получить данные с веб-страницы - PullRequest
Новая
       18

невозможно получить данные с веб-страницы

0 голосов
/ 13 апреля 2019

Я использовал этот код для автоматической загрузки некоторых полей с веб-сайта и заполнения таблицы Excel результатами поиска, но я думаю, что что-то изменилось на веб-сайте, и я не могу заставить этот код работать снова ... любая помощь, предложения? 

Sub Scramble_NAVY_search()

Dim cel As Range, ms As Worksheet, dom As HTMLDocument
Set ms = Sheets("Scramble")
'Const searchUrl = "http://www.scramble.nl/index.php?option=com_mildb&view=search"

For Each cel In ms.Range("B2:B" & ms.Range("B" & Rows.Count).End(xlUp).Row).SpecialCells(2)
    Set dom = New HTMLDocument
    Application.ScreenUpdating = False
    With CreateObject("winhttp.winhttprequest.5.1")
        .Open "POST", searchUrl, False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send "Itemid=60&af=usn&serial=" & cel & "&sbm=Search&code=&searchtype=&unit=&cn="
        dom.body.innerHTML = .responseText
    End With

    On Error Resume Next
    With cel
        If .Offset(, -1).Value = "" Then
            .Offset(, 2) = dom.getElementsByClassName("rowBord")(0).Cells(1).innerText 'Code
            .Offset(, -1) = dom.getElementsByClassName("rowBord")(0).Cells(2).innerText 'Type
            .Offset(, 10) = dom.getElementsByClassName("rowBord")(0).Cells(3).innerText 'C/N
            .Offset(, 3) = dom.getElementsByClassName("rowBord")(0).Cells(4).innerText 'Unit
            .Offset(, 11) = dom.getElementsByClassName("rowBord")(0).Cells(5).innerText 'Status
        End If
    End With
   Next

    End Sub

Ответы [ 2 ]

1 голос
/ 13 апреля 2019

Вот немного более эффективная перезапись.Я перемещаю создание объектов winhttp.winhttprequest.5.1 и dom из цикла, чтобы избежать постоянного создания и уничтожения.Перемещено Screenupdating, поэтому обрабатывается только в начале и в конце.Установите возвращаемую запись и диапазон цикла в переменные, чтобы вы могли обращаться к ним.

Обычно, я бы работал с загрузкой значений для зацикливания в массив и циклической обработкой массива.Я бы хранил результаты в массиве и выписывал один раз в конце, так как постоянное касание листа обходится дорого.Поскольку я не знаю, что происходит в других столбцах, и кажется, что в вашем диапазоне данных могут быть пробелы, я не внес эти поправки. 

Option Explicit

Public Sub ScrambleNavySearch()
    Dim cel As Range, ms As Worksheet, dom As HTMLDocument, loopRange As Range
    Const SEARCH_URL As String = "https://www.scramble.nl/index.php?option=com_mildb&view=search"

    Set ms = ThisWorkbook.Worksheets("Scramble")
    Set dom = New HTMLDocument
    Set loopRange = ms.Range("B2:B" & ms.Range("B" & rows.Count).End(xlUp).Row).SpecialCells(2)

    Application.ScreenUpdating = False

    With CreateObject("winhttp.winhttprequest.5.1")

        For Each cel In loopRange

            .Open "POST", SEARCH_URL, False
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
            .send "Itemid=60&af=usn&serial=" & cel & "&sbm=Search&code=&searchtype=&unit=&cn="
            dom.body.innerHTML = .responseText
            Dim recordFields As Object

            Set recordFields = dom.querySelectorAll(".rowBord td")

            If recordFields.Length > 0 Then
                With cel
                    .Offset(, -1) = recordFields.item(2).innerText 'Type
                    .Offset(, 2) = recordFields.item(1).innerText 'Code
                    .Offset(, 3) = recordFields.item(4).innerText 'Unit
                    .Offset(, 10) = recordFields.item(3).innerText 'C/N
                    .Offset(, 11) = recordFields.item(5).innerText 'Status
                End With
            End If
        Next
    End With
    Application.ScreenUpdating = True
End Sub
1 голос
/ 13 апреля 2019

Во-первых, закомментирована строка, где объявляется ваша searchUrl. Я не уверен, что это было сделано сознательно и нарочно. Так что начните с удаления ' перед Const searchUrl.

Во-вторых, измените searchUrl на это (в основном измените http на https):

https://www.scramble.nl/index.php?option=com_mildb&view=search

Наконец, я отредактировал форматирование кода в вашем посте. Принять изменения и использовать это форматирование. Там были некоторые разрывы строк, которые могли привести к ошибке.

Ты должен быть готов к работе.

...