Question

我使用下面提到的VBA脚本来自动进行谷歌搜索（只有英文需要的结果），但得到错误91，Plz建议解决方案。其他要求是我需要非个性化的谷歌搜索结果

Sub XMLHTTP()

    Dim url As String, lastRow As Long
    Dim XMLHTTP As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object
    Dim start_time As Date
    Dim end_time As Date

    lastRow = Range("A" & Rows.Count).End(xlUp).Row

    Dim cookie As String
    Dim result_cookie As String

    start_time = Time
    Debug.Print "start_time:" & start_time

    For i = 2 To lastRow

        url = "https://www.google.com/webhp?hl=en&as_q=&as_epq=&as_oq=&as_eq=&as_nlo=&as_nhi=&lr=lang_en&cr=countryUS&as_qdr=all&as_sitesearch=&as_occt=any&safe=images&as_filetype=&as_rights=" & Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000)

        Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
        XMLHTTP.Open "GET", url, False
        XMLHTTP.setRequestHeader "Content-Type", "text/xml"
        XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
        XMLHTTP.send

            Set html = CreateObject("htmlfile")
        html.body.innerHTML = XMLHTTP.ResponseText
        Set objResultDiv = html.getelementbyid("rso")
        Set objH3 = objResultDiv.getelementsbytagname("H3")(0)
        Set link = objH3.getelementsbytagname("a")(0)


        str_text = Replace(link.innerHTML, "<EM>", "")
        str_text = Replace(str_text, "</EM>", "")

        Cells(i, 2) = str_text
        Cells(i, 3) = link.href
        DoEvents
    Next

    end_time = Time
    Debug.Print "end_time:" & end_time

    Debug.Print "done" & "Time taken : " & DateDiff("n", start_time, end_time)
    MsgBox "done" & "Time taken : " & DateDiff("n", start_time, end_time)
End Sub

Answer 1

问题在于：设置objResultDiv = html.getelementbyid（“rso”）

如果没有“ rso ”id，则objResultDiv将为Nothing，稍后代码将失败，并显示“运行时错误'91'：对象变量或未设置块变量”

（实际错误将指向下一行，因为虽然objResultDiv什么都不是，但在您尝试评估它之前不会发生错误。）

所以你需要问问自己，我到底在寻找什么？

避免RTE的一种方法是测试objResultDiv的值：

class OrderTableManager {
  static var swiping = false
}

class OrderPreparingTableViewCell: MCSwipeTableViewCell, MCSwipeTableViewCellDelegate {
  override func gestureRecognizerShouldBegin(_ gestureRecognizer: UIGestureRecognizer) -> Bool {
    if !OrderTableManager.swiping {
      OrderTableManager.swiping = true
      return true
    } else {
      return false
    }
  }

  // MARK: Public
  func swipeTableViewCellDidEndSwiping(_ cell: MCSwipeTableViewCell!) {
    OrderTableManager.swiping = false
  }

  func displayOrder(order: AppState.Order, clock: Clock, fDone: @escaping SwipeHandler, fDelete: @escaping SwipeHandler) -> OrderPreparingTableViewCell {
    ...

    self.delegate = self

    ...
  }

这当然只是将问题推向了一条线：如果objResultDiv有一个值但是objH3没有呢？然而，它指向真正的解决方案：你想要实现什么？当你实现它时，你期待看到什么？

无论如何，这就是你获得RTE 91的原因。

对于非个性化搜索，快速谷歌（具有讽刺意味的是）建议“'简单'谷歌解决方案是在搜索查询结束时键入＆amp; pws = 0，这会关闭个性化。这种方法有这是一个耗时的缺点，对于初学者来说，很难记住。“当然，如果你自动搜索它会更快。不知道这是否有效。

Answer 2

我不确定＆＃39;英语＆＃39;部分，但下面的脚本将循环遍历A列中使用的范围，从A2开始，向下。

Sub ImportWebData()

j = 1
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True

With Sheets("Source")

   RowCount = 2
   Do While .Range("A" & RowCount) <> ""
      CellName = .Range("A" & RowCount)
      url = CellName

      'get web page
      IE.Navigate2 url
      Do While IE.readyState <> 4 Or _
         IE.Busy = True
         DoEvents
      Loop

        Set DestSh = ActiveWorkbook.Worksheets.Add
        DestSh.Name = j

            Sheets(j).Select
            Cells.Select
            Selection.Delete Shift:=xlUp
            Range("A1").Select
            With ActiveSheet.QueryTables.Add(Connection:= _
                "URL;" & CellName, Destination:=Range("$A$1"))
                .Name = CellName
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = True
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .WebSelectionType = xlEntirePage
                .WebFormatting = xlWebFormattingNone
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
            End With

            j = j + 1

    Sheets("Source").Select
    RowCount = RowCount + 1

    Loop

End With
IE.Quit

End Sub

下面的脚本将检查链接是否有效。

Option Explicit

Sub CheckHyperlinks()

    Dim oColumn As Range
    Set oColumn = Column("A") ' replace this with code to get the relevant column

    Dim oCell As Range
    For Each oCell In oColumn.Cells

        If oCell.Hyperlinks.Count > 0 Then

            Dim oHyperlink As Hyperlink
            Set oHyperlink = oCell.Hyperlinks(1) ' I assume only 1 hyperlink per cell

            Dim strResult As String
            strResult = GetResult(oHyperlink.Address)

            oCell.Offset(0, 1).Value = strResult

        End If

    Next oCell


End Sub

Private Function GetResult(ByVal strUrl As String) As String

    On Error GoTo ErrorHandler

    Dim oHttp As New MSXML2.XMLHTTP30

    oHttp.Open "HEAD", strUrl, False
    oHttp.send

    GetResult = oHttp.Status & " " & oHttp.statusText

    Exit Function

ErrorHandler:
    GetResult = "Error: " & Err.Description

End Function

Private Function GetColumn() As Range
    Set GetColumn = ActiveWorkbook.Worksheets(1).Range("A:A")
End Function

VBA自动进行谷歌搜索

2 个答案: