从第一个搜索结果返回 URL

由于Firefox是微软支持范围内的第三方浏览器，我可以帮你查看IE浏览器的VBA代码。您的要求是将描述和链接存储在单独的列中。我尝试根据您的要求修改该示例代码。这是该示例的修改后的代码。Option ExplicitConst TargetItemsQty = 1 ' results for each keywordSub 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 pageEnd SubFunction 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 FunctionFunction 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.innerTextEnd Function

从第一个搜索结果返回 URL

1回答