在 VBA 中抓取谷歌搜索结果

Question

我正在尝试根据关键字搜索 google，并在电子表格中列出网站标题、URL 和元描述。该代码运行并进行搜索，但它没有在我的电子表格中列出任何条目。几年前这曾经工作得很好，但我不确定现在发生了什么。有什么想法吗？

Sub pDownloadfromGoogle()

Dim tbl                     As Object
Dim lngLoop                 As Long
Dim objhtml                 As Object
Dim strLink                 As String
Dim varData                 As Variant
Dim objIE                   As Object
Dim strTitle                As String
Dim strURL                  As String
Dim strDescription          As String
Dim obj_g_Loop              As Object
Dim obj_tbl                 As Object
Dim objR                    As Object
Dim objR_Loop               As Object
Dim lngLastRow              As Long
Dim strCom1                 As String
Dim strCom2                 As String
Dim strCom3                 As String
Dim lngCtr                  As Long
Dim objNextPage             As Object

Application.DisplayAlerts = False
Application.DisplayAlerts = False

strCom1 = Sheet2.Range("B1").Value & "+" & Sheet2.Range("C1").Value & "+" & Sheet2.Range("D1").Value
strCom2 = Sheet2.Range("C1").Value & "+" & Sheet2.Range("D1").Value & "+" & Sheet2.Range("B1").Value
strCom3 = Sheet2.Range("D1").Value & "+" & Sheet2.Range("B1").Value & "+" & Sheet2.Range("C1").Value

varData = Array(strCom1, strCom2, strCom3)
    
L = Sheet1.Cells(Sheet1.Rows.Count, "C").End(xlUp).Row + 1
Sheet1.Range("C2:F" & L).ClearContents

For lngLoop = 0 To UBound(varData)

    Set objIE = CreateObject("InternetExplorer.Application")
    With objIE
        .Visible = False

        .navigate "https://www.google.com/search?q=" & varData(lngLoop)
        Do While .busy 'Or .readyState <> 4
            DoEvents
            Application.Wait DateAdd("s", 1, Now)
        Loop
    End With
        
LoopAgain:
    On Error Resume Next
    Set obj_tbl = objIE.document.getElementsByClassName("g")
                
    I = 1
    L = 1
    For Each obj_g_Loop In obj_tbl
        
        L = Sheet1.Cells(Sheet1.Rows.Count, "C").End(xlUp).Row + 1
            
        Set objR = obj_g_Loop.getElementsByClassName("r")
        strTitle = objR(0).innertext
        strURL = objR(0).getElementsByTagName("a")(0).href
            
        Set objR = obj_g_Loop.getElementsByClassName("st")
        strDescription = objR(0).innertext
            
        Sheet1.Cells(L, "C") = strTitle
        Sheet1.Cells(L, "D") = strURL
        Sheet1.Cells(L, "E") = strDescription
                            
        Set objR = Nothing
        strTitle = ""
        strURL = ""
        strDescription = ""
            
    Next obj_g_Loop
    
    lngCtr = lngCtr + 1
    
    If lngCtr < 3 Then
        Set objNextPage = objIE.document.getElementByid("pnnext")
        
        objNextPage.Click
        Application.Wait (Now + TimeValue("0:00:5"))
        GoTo LoopAgain
    End If
    
'        Stop
         
objIE.Quit

lngCtr = 0
Next lngLoop
            
Sheet1.Range("$C$1:$E$" & L).RemoveDuplicates Columns:=2, Header:=xlYes
            
MsgBox "Process Complete!"
            
Application.DisplayAlerts = True
Application.DisplayAlerts = True
   
End Sub