Excel宏 - 在Google上搜索电话号码

时间:2015-06-04 10:51:47

标签: excel vba excel-vba

我想在Excel中构建一个宏来打开谷歌浏览器并搜索列F的内容(公司名称),然后将该公司的电话号码保存到列G中。许多公司的电话号码弹出结果。如果找不到电话号码,我想(至少)让Excel打开Goog​​le并搜索这些信息,而无需复制和过去数百次。此外,为了防止系统崩溃或打开过多的Google标签,我希望宏从我已经做出的选择中搜索...我正在尝试实现下面找到的代码。我不得不承认,我是一个没有经验的VBA用户。你能给予的任何帮助都会很棒......我为自己的无知而道歉。

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("F" & 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.co.in/search?q=" & 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

0 个答案:

没有答案