使用 VBA 出错后重置 html 元素

Posted 2023-03-16

【中文标题】使用 VBA 出错后重置 html 元素

【英文标题】：Reset an html element after error with VBA

【发布时间】：2020-11-27 19:00:49

【问题描述】：

在刮板宏上，我试图越过错误并在没有数据可抓取时返回“输入错误”。

现在我正在使用这个：

Public Function translate()

    Set thisWbs = ActiveWorkbook.ActiveSheet
    Set ie = CreateObject("InternetExplorer.Application")
    link = "https://translate.google.com/#view=home&op=translate&sl=auto&tl=en"
    i = 2

    ie.Visible = True

    LastRow = thisWbs.Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row

    Set Rng = thisWbs.Range("B2:B" & LastRow)

    For Each cell In Rng

        my_url = link
        ie.navigate my_url
        
        Wait 2
    
        While ie.readyState <> 4 Or ie.Busy: DoEvents: Wend
        
        ie.document.getElementById("source").innerText = ActiveSheet.Range("B" & i)
        
        Wait 2

        If ie.document.getElementsByClassName("empty-placeholder placeholder")(0).innerText = "Translation" Then
            ActiveSheet.Range("C" & i) = "input error"
        Else
            ActiveSheet.Range("C" & i) = ie.document.getElementsByClassName("tlid-translation translation")(0).innerText
        End If

        Wait 1
        
        ie.document.getElementsByClassName("empty-placeholder placeholder")(0).innerText = " "
        
        i = i + 1

    Next cell

    ie.Quit

    MsgBox "Done"
    
End Function

它可以工作，它会为找到的第一个错误返回“输入错误”，但是当它发现另一个错误时，该类仍然是“”，就像之前设置的那样，所以它无法再次找到“翻译”并停止工作。有什么想法吗？

【问题讨论】：

如果不使用ie.document.getElementsByClassName("empty-placeholder placeholder")(0).innerText = " "这一行会怎样？

如果我删除该行，在返回一次“输入错误”后，它将返回所有剩余搜索的“输入错误”

我只能看到你的一部分代码。我想您的代码导航到另一个 URL。这个假设不是真的吗？如果是，您的代码应该读取新的类名innerText。返回“翻译”不是必须清除的错误。您确定您的代码分析了另一个 URL 吗？在您的代码中，my_url 在哪里更改？如果没有，在代码存在循环之前都是一样的。

在模块顶部使用 option explicit 并声明所有变量。此外，缩进和间距（例如按编辑）使代码流更易于遵循。

我不知道你为什么要包含这一行 ie.document.getElementsByClassName("empty-placeholder placeholder")(0).innerText = " " ？该过程是否没有转到页面并从工作表中输入文本，然后检查特定元素的 innerText 以查看是否有“翻译”？怀疑您是否需要那些额外的 Wait 调用。请使用明确的工作表引用而不是 Activesheet。

【参考方案1】：

请尝试下一个代码：

Private Sub translate()
  Dim thisWbs As Worksheet, IE As Object, link As String
  Dim i As Long, lastRow As Long, my_url As String
  
    Set thisWbs = ActiveSheet
    Set IE = CreateObject("InternetExplorer.Application")
    link = "https://translate.google.com/#view=home&op=translate&sl=auto&tl=en"
    
    'IE.Visible = True
    lastRow = thisWbs.Range("B" & Rows.count).End(xlUp).Row
    thisWbs.Range("C2:C" & lastRow).Clear
    
    For i = 2 To lastRow
        my_url = link & "&text=" & Replace(ActiveSheet.Range("B" & i).Value, " ", "%20")
        IE.navigate my_url

        While IE.readyState <> 4 Or IE.Busy: DoEvents: Wend
        
        Application.Wait (Now + TimeValue("0:00:1"))

        If IE.Document.getElementsByClassName("empty-placeholder placeholder")(0).innerText = "Translation" Then
            ActiveSheet.Range("C" & i) = "input error"
        Else
            ActiveSheet.Range("C" & i) = IE.Document.getElementsByClassName("tlid-translation translation")(0).innerText
        End If
    Next i

    IE.Quit
    MsgBox "Done"
End Sub

我测试过了。我调整了你的，以使其正常工作。

现在，请尝试下一个功能（更快更可靠，不需要 Internet Explorer），请：

Private Function GTranslate(strInput As String, strFromLang As String, strToLang As String) As String
    Dim strURL As String, objHTTP As Object, objhtml As Object, objDivs As Object, objDiv As Variant
    
    strURL = "https://translate.google.com/m?hl=" & strFromLang & _
        "&sl=" & strFromLang & _
        "&tl=" & strToLang & _
        "&ie=UTF-8&prev=_m&q=" & strInput
        
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    objHTTP.Open "GET", strURL, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ""
    
    Set objHTML = CreateObject("htmlfile")
    With objHTML
        .Open
        .Write objHTTP.responseText
        .Close
    End With
    
    Set objDivs = objHTML.getElementsByTagName("div")
    For Each objDiv In objDivs
        If objDiv.className = "t0" Then
            GTranslate = objDiv.innerText: Exit For
        End If
    Next objDiv
    
    Set objHTML = Nothing: Set objHTTP = Nothing
End Function

我在互联网上找到了它（几年前），根据我的需要对其进行了调整，现在为你的需要...

你的代码，使用上面的函数，会变成：

Private Sub Google_translate()
  Dim thisWbs As Worksheet
  Dim i As Long, lastRow As Long
  
  Set thisWbs = ActiveSheet
  lastRow = thisWbs.Range("B" & Rows.count).End(xlUp).Row
  thisWbs.Range("C2:C" & lastRow).Clear
  
  For i = 2 To lastRow
    thisWbs.Range("C" & i).Value = GTranslate(thisWbs.Range("B" & i).Value, "auto", "en")
  Next i
  MsgBox "Ready..."
End Sub

【讨论】：

link = "translate.google.com/…" and my_url = link & Replace(ActiveSheet.Range("B" & i).Value, " ", "%20") 或 my_url = link & cell & Replace(ActiveSheet.Range("B" & i).Value, " ", "%20") 两个版本都在 ie.navigate my_url 上给出错误

只需复制我的答案代码行。你错过了“&text="...

我没有错过，我已经将它包含在主链接中

@Psko：请复制您所拥有的确切代码行。

好主意，虽然我首先会使用 EncodeURL 函数调用，而不是使用 Replace。