Searching websites using VBA

What I would like to do is to search a website using VBA, putting some words in the left box and getting results on the right.

The problem is that I don't know HTML and I don't know how to refer to this box. I use GetElementByID but I received error in line:

objIE.Document.GetElementByID("text-translation-video-ad").Value = "pi?ka".   
"Object doesn't support this property or method".

Here's my code:

Sub www()

    Set objIE = CreateObject("InternetExplorer.Application")

    objIE.Top = 0
    objIE.Left = 0
    objIE.Width = 800
    objIE.Height = 600
    objIE.AddressBar = 0
    objIE.StatusBar = 0
    objIE.Toolbar = 0
    objIE.Visible = True
    objIE.Navigate ("https://pl.pons.com/t?umaczenie-tekstu")

    Do
        DoEvents
    Loop Until objIE.ReadyState = 4

    pagesource = objIE.Document.Body.Outerhtml
    objIE.Document.GetElementByID("text-translation-video-ad").Value = "pi?ka"
    objIE.Document.GetElementByID("qKeyboardInputInitiator").Click

    Do
        DoEvents
    Loop Until objIE.ReadyState = 4

End Sub

Answers:

Answer

Without changing any language settings, the following translates "Hello"

Code:

Option Explicit

Public Sub GetInfo()
    Dim IE As New InternetExplorer, html As HTMLDocument, translation As String
    Const TRANSLATION_STRING As String = "Hello"

    With IE
        .Visible = True
        .navigate "https://pl.pons.com/t%C5%82umaczenie-tekstu"

        While .Busy Or .readyState < 4: DoEvents: Wend

        Set html = .document

        With html
            .querySelector("textarea.text-translation-source.source").Value = TRANSLATION_STRING
            .querySelector("button.btn.btn-primary.submit").Click
            Application.Wait Now + TimeSerial(0, 0, 3)
            translation = .querySelector("div.translated_text").innerText
        End With

        Debug.Print translation
        'Quit '<== Remember to quit application
    End With

End Sub

View:

Output

Print out in immediate window:

Output


Edit:

Late bound version

Option Explicit

Public Sub GetInfo()
    Dim IE As Object, html As Object

    With CreateObject("InternetExplorer.Application")
        .Visible = True
        .navigate "https://pl.pons.com/t%C5%82umaczenie-tekstu"

        While .Busy Or .readyState < 4: DoEvents: Wend

        Set html = CreateObject("htmlfile")
        Set html = .document

        With html

            .getElementsByClassName("text-translation-source source")(0).innerText = "Translate"
            .getElementsByClassName("btn btn-primary submit")(0).Click
             Application.Wait Now + TimeSerial(0, 0, 2)

             Dim i As Long
             For i = 0 To .getElementsByClassName("text-translation-target target").Length - 1
                 Debug.Print .getElementsByClassName("text-translation-target target")(i).innerText
             Next i

            Stop
        End With
        .Quit
    End With

End Sub
Answer

Element with ID "text-translation-video-ad" is a DIV which does not have .Value property. You want to access text area which is descendant of mentioned DIV.

There are 2 elements with tag "textarea" on page, the one which interests you is 1st element, therefore (0) index. Tags in GetElementsByTagName must be capitalized.

objIE.Document.GetElementsByTagName("TEXTAREA")(0).Value = "pi?ka"

You can also resign from IE automation and take a faster and more reliable approach, without browser automation, which will give you response in JSON format. Setting reference to Microsoft HTML Object Library is required.

Option Explicit

Public Sub Scrape()

    Dim WindHttp As Object: Set WindHttp = CreateObject("WinHTTP.WinHTTPRequest.5.1")
    Dim htmlDoc As New HTMLDocument
    Dim urlName As String, myWord As String, requestString As String
    Dim myResults() As String
    Dim resultNum As Long

    urlName = "https://pl.pons.com/_translate/translate"
    myWord = "pi?ka"

    requestString = "source_language=pl&target_language=en&service=deepl&text=" & _
    myWord & _
    "&lookup=true&requested_by=Web&source_language_confirmed=true"

    Set htmlDoc = postDocument(urlName, WindHttp, requestString)

    myResults = Split(Replace(Split(Split(htmlDoc.body.innerText, ",")(1), ":")(1), Chr(34), vbNullString), vbCrLf)

    For resultNum = LBound(myResults) To UBound(myResults)
        Debug.Print myResults(resultNum)
    Next resultNum

End Sub

Function postDocument(ByVal urlName As String, myRequest As Object, Optional requestString As String) As HTMLDocument

    Set postDocument = New HTMLDocument

    With myRequest

        .Open "POST", urlName, False
        .setRequestHeader "Cache-Control", "no-cache"
        .setRequestHeader "Pragma", "no-cache"
        .setRequestHeader "Content-type", "application/x-www-form-urlencoded"

        If requestString = vbNullString Then
            .send
        Else
            .send requestString
        End If

        postDocument.body.innerHTML = .responseText

    End With

End Function

Tags

Recent Questions

Top Questions

Home Tags Terms of Service Privacy Policy DMCA Contact Us

©2020 All rights reserved.