使用 VBA 搜索网站

Question

我想做的是使用 VBA 搜索website，在左侧框中输入一些单词并在右侧获取结果。

问题是我不懂 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

在不更改任何语言设置的情况下，以下翻译为“你好”

代码：

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