- Public a As Boolean
- Sub StartTimer()
- Range("E7") = "自動更新：開啟"
- If a = True Then End
- DoEvents
- Application.OnTime Now + TimeValue("00:00:01"), "StartTimer2", Schedule:=True
- End Sub
- Sub StartTimer2()
- DoEvents
- Call NewsOne '你的SUB
- Call StartTimer
- End Sub
- Sub StopTimer()
- a = IIf(a = True, False, True)
- Range("E7") = "自動更新：關閉"
- On Error Resume Next
- Application.OnTime Now + TimeValue("00:00:05"), "StartTimer2", Schedule:=False
- End Sub
- Sub NewsOne()
- 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 = 1 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, 7) = str_text
- Cells(i, 8) = 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
錯誤原因落在str_text = Replace(link.innerHTML, "<EM>", "")
還請老師們賜教，謝謝。 |
發表於 2017-8-8 16:46
| 
