Advertisement
Guest User

Untitled

a guest
May 25th, 2016
58
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 3.15 KB | None | 0 0
  1. Sub XMLHTTP2()
  2.  
  3. Dim url As String, lastRow As Long
  4. Dim XMLHTTP As Object, html As Object, objResultDiv As Object, link As Object, objH3 As Object
  5. Dim start_time As Date
  6. Dim end_time As Date
  7.  
  8. lastRow = Range("A" & Rows.Count).End(xlUp).Row
  9.  
  10. Dim cookie As String
  11. Dim result_cookie As String
  12.  
  13. start_time = Time
  14. Debug.Print "start_time:" & start_time
  15.  
  16.  
  17. For i = 1 To lastRow
  18. c = 0
  19. d = 1
  20. url = "https://www.google.com.br/search?num=100&site=webhp&source=hp&q=" & Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000)
  21.  
  22. Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
  23. XMLHTTP.Open "GET", url, False
  24. XMLHTTP.setRequestHeader "Content-Type", "text/xml"
  25. XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
  26. XMLHTTP.send
  27.  
  28.  
  29. Set html = CreateObject("htmlfile")
  30. html.body.innerHTML = XMLHTTP.ResponseText
  31. Set objResultDiv = html.getelementbyid("rso")
  32.  
  33. Set objH3 = objResultDiv.getElementsByTagName("H3")
  34. For Each objH3sep In objH3
  35. On Error Resume Next
  36. Set link = objH3sep.getElementsByTagName("a")(0)
  37. str_text = Replace(link.innerHTML, "<EM>", "")
  38. str_text = Replace(str_text, "</EM>", "")
  39. c = c + 2
  40. d = d + 2
  41. Cells(i, c) = str_text
  42. Cells(i, d) = link.href
  43. Next
  44. DoEvents
  45.  
  46. url = "https://www.google.com.br/search?num=100&start=200&site=webhp&source=hp&q=" & Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000)
  47.  
  48. Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
  49. XMLHTTP.Open "GET", url, False
  50. XMLHTTP.setRequestHeader "Content-Type", "text/xml"
  51. XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
  52. XMLHTTP.send
  53.  
  54.  
  55. Set html = CreateObject("htmlfile")
  56. html.body.innerHTML = XMLHTTP.ResponseText
  57. Set objResultDiv = html.getelementbyid("rso")
  58.  
  59. Set objH3 = objResultDiv.getElementsByTagName("H3")
  60. For Each objH3sep In objH3
  61. On Error Resume Next
  62. Set link = objH3sep.getElementsByTagName("a")(0)
  63. str_text = Replace(link.innerHTML, "<EM>", "")
  64. str_text = Replace(str_text, "</EM>", "")
  65. c = c + 2
  66. d = d + 2
  67. Cells(i, c) = str_text
  68. Cells(i, d) = link.href
  69. Next
  70. DoEvents
  71.  
  72. Next
  73.  
  74. With ActiveSheet
  75. Range("A1").Select
  76. Range(Selection, Selection.End(xlDown)).Select
  77. Range(Selection, Selection.End(xlToRight)).Select
  78. Selection.Copy
  79. Cells(Application.Rows.Count, 1).End(xlUp).Offset(2, 0).Value = "Results"
  80. Cells(Application.Rows.Count, 1).End(xlUp).Offset(2, 0).Select
  81. Selection.PasteSpecial Paste:=xlPasteValues, transpose:=True
  82.  
  83. End With
  84.  
  85. end_time = Time
  86.  
  87.  
  88. Debug.Print "end_time:" & end_time
  89.  
  90. Debug.Print "done" & "Time taken : " & DateDiff("n", start_time, end_time)
  91. MsgBox "done" & "Time taken : " & DateDiff("n", start_time, end_time)
  92. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement