我有一個(gè)包含大約 25,000 個(gè)公司關(guān)鍵字的 Excel 工作簿，我想從中獲取公司網(wǎng)站 URL。我希望運(yùn)行一個(gè) VBA 腳本，該腳本可以將這些關(guān)鍵字作為 Google 搜索來運(yùn)行，并將第一個(gè)結(jié)果的 URL 拉入電子表格中。我發(fā)現(xiàn)了一個(gè)類似的線程。這樣做的結(jié)果是偶然的；某些關(guān)鍵字會(huì)在下一列中返回 URL，其他關(guān)鍵字則保留空白。它還似乎在第一個(gè)搜索結(jié)果中提取了 Google 優(yōu)化子鏈接的 URL，而不是主網(wǎng)站 URL：Google 搜索結(jié)果示例然后我在這里找到了下面的代碼，我在包含 1,000 個(gè)關(guān)鍵字的示例列表上運(yùn)行了該代碼。該博客的作者規(guī)定該代碼適用于 Mozilla Firefox。我測試了他也編寫的 IE 代碼，但這并沒有達(dá)到相同的結(jié)果（它添加了由搜索結(jié)果中的描述性文本組成的超鏈接，而不是原始 URL）。Firefox 代碼一直運(yùn)行到第 714行，然后返回錯(cuò)誤消息“運(yùn)行時(shí)錯(cuò)誤 91：未設(shè)置對象變量或 with 塊變量”顯示成功結(jié)果和宏停止的行的電子表格布局Sub GoogleURL () Dim url As String, lastRow As Long Dim XMLHTTP As Object Dim html As Object Dim objResultDiv As Object Dim objH As Object lastRow = Range(“A” & Rows.Count).End(xlUp).Row For i = 2 To lastRow url = “https://www.google.co.uk/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 objH = objResultDiv.getelementsbytagname(“h3”)(0) Cells(i, 2).Value = objH.innerText Set html = CreateObject(“htmlfile”) html.body.innerHTML = XMLHTTP.ResponseText Set objResultDiv = html.getelementbyid(“rso”) Set objH = objResultDiv.getelementsbytagname(“cite”)(0) Cells(i, 3).Value = objH.innerText DoEvents NextEnd Sub
1 回答
九州編程
TA貢獻(xiàn)1785條經(jīng)驗(yàn) 獲得超4個(gè)贊
由于Firefox是微軟支持范圍內(nèi)的第三方瀏覽器，我可以幫你查看IE瀏覽器的VBA代碼。
您的要求是將描述和鏈接存儲(chǔ)在單獨(dú)的列中。
我嘗試根據(jù)您的要求修改該示例代碼。
這是該示例的修改后的代碼。
Option Explicit
Const TargetItemsQty = 1 ' results for each keyword
Sub GWebSearchIECtl()
? ? Dim objSheet As Worksheet
? ? Dim objIE As Object
? ? Dim x As Long
? ? Dim y As Long
? ? Dim strSearch As String
? ? Dim lngFound As Long
? ? Dim st As String
? ? Dim colGItems As Object
? ? Dim varGItem As Variant
? ? Dim strHLink As String
? ? Dim strDescr As String
? ? Dim strNextURL As String
? ? Set objSheet = Sheets("Sheet1")
? ? Set objIE = CreateObject("InternetExplorer.Application")
? ? objIE.Visible = True ' for debug or captcha request cases
? ? y = 1 ' start searching for the keyword in the first row
? ? With objSheet
? ? ? ? .Select
? ? ? ? .Range(.Columns("B:B"), .Columns("B:B").End(xlToRight)).Delete ' clear previous results
? ? ? ? .Range(.Columns("C:C"), .Columns("C:C").End(xlToRight)).Delete ' clear previous results
? ? ? ? .Range("A1").Select
? ? ? ? Do Until .Cells(y, 1) = ""
? ? ? ? ? ? x = 2 ' start writing results from column B
? ? ? ? ? ? .Cells(y, 1).Select
? ? ? ? ? ? strSearch = .Cells(y, 1) ' current keyword
? ? ? ? ? ? With objIE
? ? ? ? ? ? ? ? lngFound = 0
? ? ? ? ? ? ? ? .navigate "https://www.google.com/search?q=" & EncodeUriComponent(strSearch) ' go to first search results page
? ? ? ? ? ? ? ? Do
? ? ? ? ? ? ? ? ? ? Do While .Busy Or Not .READYSTATE = 4: DoEvents: Loop ' wait IE
? ? ? ? ? ? ? ? ? ? Do Until .document.READYSTATE = "complete": DoEvents: Loop ' wait document
? ? ? ? ? ? ? ? ? ? Do While TypeName(.document.getelementbyid("res")) = "Null": DoEvents: Loop ' wait [#res] element
? ? ? ? ? ? ? ? ? ? Set colGItems = .document.getelementbyid("res").getElementsByClassName("g") ' collection of search result [.g] items
? ? ? ? ? ? ? ? ? ? For Each varGItem In colGItems ' process each item in collection
? ? ? ? ? ? ? ? ? ? ? ? If varGItem.getelementsbytagname("a").Length > 0 And varGItem.getElementsByClassName("st").Length > 0 Then ' must have hyperlink and description
? ? ? ? ? ? ? ? ? ? ? ? ? ? strHLink = varGItem.getelementsbytagname("a")(0).href ' get first hyperlink [a] found in current item
? ? ? ? ? ? ? ? ? ? ? ? ? ? strDescr = GetInnerText(varGItem.getElementsByClassName("st")(0).innerHTML) ' get first description [span.st] found in current item
? ? ? ? ? ? ? ? ? ? ? ? ? ? lngFound = lngFound + 1
? ? ? ? ? ? ? ? ? ? ? ? ? ? 'Debug.Print (strHLink)
? ? ? ? ? ? ? ? ? ? ? ? ? ? 'Debug.Print (strDescr)
? ? ? ? ? ? ? ? ? ? ? ? ? ? With objSheet ' put result into cell
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?.Cells(y, x).Value = strDescr
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?.Hyperlinks.Add .Cells(y, x + 1), strHLink
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? .Cells(y, x).WrapText = True
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? x = x + 1 ' next column
? ? ? ? ? ? ? ? ? ? ? ? ? ? End With
? ? ? ? ? ? ? ? ? ? ? ? ? ? If lngFound = TargetItemsQty Then Exit Do ' continue with next keyword - necessary quantity of the results for current keyword found
? ? ? ? ? ? ? ? ? ? ? ? End If
? ? ? ? ? ? ? ? ? ? ? ? DoEvents
? ? ? ? ? ? ? ? ? ? Next
? ? ? ? ? ? ? ? ? ? If TypeName(.document.getelementbyid("pnnext")) = "Null" Then Exit Do ' continue with next keyword - no [a#pnnext.pn] next page button exists
? ? ? ? ? ? ? ? ? ? strNextURL = .document.getelementbyid("pnnext").href ' get next page url
? ? ? ? ? ? ? ? ? ? .navigate strNextURL ' go to next search results page
? ? ? ? ? ? ? ? Loop
? ? ? ? ? ? End With
? ? ? ? ? ? y = y + 1 ' next row
? ? ? ? Loop
? ? End With
? ? objIE.Quit
? ? ' google web search page contains the elements:
? ? ' [div#res] - main search results block
? ? ' [div.g] - each result item block within [div#res]
? ? ' [a] - hyperlink ancor(s) within each [div.g]
? ? ' [span.st] - description(s) within each [div.g]
? ? ' [a#pnnext.pn] - hyperlink ancor to the next search results page
End Sub
Function EncodeUriComponent(strText As String) As String
? ? Static objHtmlfile As Object
? ? If objHtmlfile Is Nothing Then
? ? ? ? Set objHtmlfile = CreateObject("htmlfile")
? ? ? ? objHtmlfile.parentWindow.execScript "function encode(s) {return encodeURIComponent(s)}", "jscript"
? ? End If
? ? EncodeUriComponent = objHtmlfile.parentWindow.encode(strText)
End Function
Function GetInnerText(strText As String) As String
? ? Static objHtmlfile As Object
? ? If objHtmlfile Is Nothing Then
? ? ? ? Set objHtmlfile = CreateObject("htmlfile")
? ? ? ? objHtmlfile.Open
? ? ? ? objHtmlfile.Write "<body></body>"
? ? End If
? ? objHtmlfile.body.innerHTML = strText
? ? GetInnerText = objHtmlfile.body.innerText
End Function
- 1 回答
- 0 關(guān)注
- 154 瀏覽
添加回答
舉報(bào)
0/150
提交
取消