使用VBA搜索網站

Question

我想做的是使用VBA搜索網站 ，在左側框中輸入一些單詞，然后在右側獲得結果。

問題是我不了解HTML，也不知道如何引用此框。 我使用GetElementByID但在行中收到錯誤：

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

這是我的代碼：

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

Answer 1

在不更改任何語言設置的情況下，以下內容翻譯為“ Hello”

碼：

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

視圖：

在即時窗口中打印出：

---

編輯：

后期綁定版本

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 2

ID為“ text-translation-video-ad”的元素是不具有.Value屬性的DIV。 您要訪問提到的DIV的后代的文本區域。

頁面上有2個標簽為“ textarea”的元素，您感興趣的元素是第一個元素，因此為（0）索引。 GetElementsByTagName標簽必須大寫。

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

您還可以從IE自動化中退出，並采取更快，更可靠的方法，而無需使用瀏覽器自動化，這將使您以JSON格式進行響應。 必須設置對Microsoft HTML對象庫的引用。

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