1

我正在尝试使用 vba 自动化 Internet Explorer,下面是我的代码:

Sub go_IE()
Dim objIE As SHDocVw.InternetExplorer
Dim htmlColl As MSHTML.IHTMLElementCollection
Dim htmlInput As MSHTML.HTMLInputElement
Dim htmlDoc As MSHTML.HTMLDocument

Set objIE = New SHDocVw.InternetExplorer

objIE.Visible = True

objIE.Navigate "example.com/abc/home/" 'load web page google.com

While objIE.Busy
  DoEvents  'wait until IE is done loading page.
Wend

Set htmlDoc = objIE.Document 'htmlDoc now holds home page

Set htmlColl = htmlDoc.getElementsByTagName("button")

For Each htmlInput In htmlColl

                    If htmlInput.Type = "submit" Then
                        htmlInput.Click     ' click on the submit button
                    End If

Next htmlInput

While objIE.Busy
  DoEvents  'wait until IE is done loading page.
Wend

Set htmlDoc = objIE.Document

Set htmlColl = htmlDoc.getElementsByTagName("button")

For Each htmlInput In htmlColl

                    If htmlInput.Type = "submit" Then
                        htmlInput.Click     ' click on the submit button
                    End If

Next htmlInput

While objIE.Busy
  DoEvents  'wait until IE is done loading page.
Wend


objIE.Quit


End Sub

一旦我点击主页并导航到下一页,下面的行没有给我任何东西:

Set htmlDoc = objIE.Document

它只是说权限被拒绝。

我做了很少的研究,发现这与同源政策有关。但是我检查了,点击主页中的提交按钮后,网址没有改变。

任何机构可以帮助我解决这个问题或任何建议吗?

4

1 回答 1

1

您可以考虑使用 xmlHTTP 对象而不是使用 IE。
HTTP 请求更简单,更快

下面是示例代码

Sub xmlHttp()

    Dim URl As String, lastRow As Long
    Dim xmlHttp As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object


    lastRow = Range("A" & Rows.Count).End(xlUp).Row

    For i = 2 To lastRow

        URl = "https://www.google.co.in/search?q=" & Cells(i, 1)

        Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
        xmlHttp.Open "GET", URl, False
        xmlHttp.setRequestHeader "Content-Type", "text/xml"
        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, 2) = str_text
        Cells(i, 3) = link.href
    Next
End Sub

在此处输入图像描述

HTH
桑托什

于 2013-07-06T04:00:42.907 回答