2016-09-07 1 views
3

Согласно this post Я исправил проверку объекта. Иногда код будет работать нормально для 10 записей, что делает их правильными, иногда он будет работать в течение пяти. Иногда это неправильно.Что прерывает мой короткий блок VBA?

Он всегда терпит неудачу при получении внутреннего текста элемента. Когда он получает результат Y/N неправильно, я вообще не знаю, что вызывает это.

Пожалуйста, помогите! Это сводит меня с ума. Я проверял ошибку на каждом этапе снова и снова.

Sub LetsAutomateIE() 

Dim barcode As String 
Dim rowe As Integer 
Dim document As HTMLDocument 
Dim Element As HTMLDivElement 
Dim text As String 
Dim pos As Integer 

Set ie = CreateObject("InternetExplorer.Application") 
rowe = 2 

While Not IsEmpty(Cells(rowe, 2)) 
    barcode = Cells(rowe, "B").Value 
    pos = 0 
    text = "" 
    Set document = Nothing 

    With ie 
     .Visible = False 
     .navigate2 "https://www.amazon.co.uk/s/ref=nb_sb_noss_1?url=search-alias%3Daps&field-keywords=" & barcode 
     Do Until ie.readyState = 4 
     Loop 
    End With 

    Set document = ie.document 

    If IsObject(document.getElementById("result_0")) = False Then GoTo Here 

    text = document.getElementById("result_0").innerText 
    If InStr(text, "STEELBOOK") Or InStr(text, "Steelbook") Or InStr(text, "Steel book") <> 0 Then pos = 1 

    If pos <> 0 Then Cells(rowe, 4) = "Y" Else Cells(rowe, 4) = "N" 

    Here: 

    rowe = rowe + 1 
Wend 
Set ie = Nothing 

End Sub 

Ниже представлен выбор образцов штрих-кодов, с которыми я работал. Мне никогда не удавалось успешно справиться с этим.

5030305517076 
5030305517816 
5060223767925 
5060223767949 
5060223767956 
5060223767970 
5060223767994 
8717418358563 
8717418365851 

Спасибо большое,

Сэм

+2

Положить 'DoEvents' в цикл ожидания? – GSerg

ответ

3

Одной из проблем является то, что для некоторых штрих-кодов не найдено. Если бы проверить свой код с IE.Visible = true тогда вы увидите текст, как это:

Ваш поиск «5060223767949» не найдено ни одного товара.

Другой проблемой является состояние IsObject(document.getElementById("result_0")) = False. Это не работает, потому что IsObject(Nothing) возвращает true. Лучше было бы использовать If <variable-name> Is Nothing Then ....

Полный код. НТН

' Add reference to Microsoft Internet Controls (SHDocVw) 
' Add reference to Microsoft HTML Object Library 

Sub LetsAutomateIE() 
    Dim IE As SHDocVw.InternetExplorer 
    Dim barcode As String 
    Dim rowe As Integer 
    Dim document As HTMLDocument 
    Dim Element As HTMLDivElement 
    Dim result01 As HTMLListElement 
    Dim noResults As HTMLHeaderElement 
    Dim text As String 
    Dim pos As Integer 
    Dim url As String 

    rowe = 2 
    url = "https://www.amazon.co.uk/s/ref=nb_sb_noss_1?url=search-alias%3Daps&field-keywords=" 
    Set IE = New SHDocVw.InternetExplorer 

    While Not IsEmpty(Cells(rowe, 2)) 
     barcode = Cells(rowe, "B").Value 
     pos = 0 
     text = "" 

     IE.Navigate url & barcode 

     While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE 
      DoEvents 
     Wend 

     Set document = IE.document 
     Set result01 = document.getElementById("result_0") 

     If result01 Is Nothing Then 
      Set noResults = document.getElementById("noResultsTitle") 
      If Not noResults Is Nothing Then MsgBox noResults.outerText 
      GoTo Here 
     End If 

     text = document.getElementById("result_0").innerText 
     If InStr(text, "STEELBOOK") Or InStr(text, "Steelbook") Or InStr(text, "Steel book") <> 0 Then pos = 1 

     If pos <> 0 Then Cells(rowe, 4) = "Y" Else Cells(rowe, 4) = "N" 

Here: 
     rowe = rowe + 1 
    Wend 

    IE.Quit 
    Set IE = Nothing 

End Sub 

Я на самом деле ищет просто проверить название первого возвращенного продукта на странице ...

Заголовок отображается с h2 элементом в li с id result_0. Таким образом, можно ограничить поиск именно этим элементом li и выполнить поиск первого элемента h2.

' text = document.getElementById("result_0").innerText 

Dim h2Elements As IHTMLElementCollection 
Dim h2 As HTMLHeadElement 

Set h2Elements = result01.getElementsByTagName("h2") 

If h2Elements.Length > 0 Then 
    Set h2 = h2Elements.Item(0) 
    text = h2.innerText 
    Debug.Print text 
Else 
    MsgBox "Text not found"  
End If 

Выход:

RED 2 Blu-ray Steelbook UK Exclusive 
The Hunger Games With Mockingjay Pendant 
The Hunger Games 
The Hunger Games 
Avengers Assemble BD Steelbook 
Avengers Assemble Bonus Disc BD Retail 
+0

Спасибо вам большое за помощь!Я видел, что продукт не найден, и именно поэтому я пытался найти, есть ли результат_0, поскольку этот фрейм не появляется (я считаю) в этом обстоятельстве. Я с нетерпением жду, чтобы попробовать ваш код прямо сейчас! Еще раз спасибо :) – Sam

+0

Один последний вопрос, если кто-то наткнется на это и может помочь: я на самом деле ищу только, чтобы проверить название первого возвращенного продукта на странице. Я в настоящее время просматриваю весь текст в фрейме/классе/Я не уверен, как его назвать. Можно ли ограничить поиск только заголовком? – Sam

+1

@Sam см. Отредактированный ответ. Я рад, что это помогло :). – dee

0

у меня была проблема с document.getElementById("result_0") бросает ошибку. Моим обходным путем было проверить, был ли элемент в Document.Body.InnerHTML.

Если вы установили DebugMode в True, то веб-страница с плохими результатами остается открытой для дальнейшего осмотра.

Штрих-код будет отмечен как NA, если не найден.

Option Explicit 

Sub LetsAutomateIE() 
    Const DebugMode As Boolean = True 
    Dim barcode As String, text As String 
    Dim rowe As Integer 
    Dim doc As HTMLDocument, liResults As HTMLLIElement 
    Dim ie As Object 

    Set ie = CreateObject("InternetExplorer.Application") 

    rowe = 2 

    While Not IsEmpty(Cells(rowe, 2)) 
     barcode = Cells(rowe, "B").Value 

     With ie 
      .Visible = False 
      .navigate2 "https://www.amazon.co.uk/s/ref=nb_sb_noss_1?url=search-alias%3Daps&field-keywords=" & barcode 
      Do Until ie.readyState = 4 
      Loop 
     End With 

     Set doc = ie.document 
     If InStr(doc.body.innerHTML, "li id=""result_0""") Then 

      Set liResults = doc.getElementById("result_0") 
      text = liResults.innerText 
      Cells(rowe, 4) = IIf(InStr(text, "STEELBOOK") Or InStr(text, "Steelbook") Or InStr(text, "Steel book"), "Y", "N") 

     Else 
      Cells(rowe, 4) = "NA" 
      If DebugMode Then 
       ie.Visible = True 
       Set ie = CreateObject("InternetExplorer.Application") 
      End If 
     End If 
     rowe = rowe + 1 
    Wend 

    ie.Quit 

    Set ie = Nothing 

End Sub 
+0

Спасибо большое Томас :) – Sam

+1

Добро пожаловать Сэм –

Смежные вопросы