IEObject.document权限被拒绝错误 - 任何建议

时间:2012-10-13 14:04:51

标签: internet-explorer vba excel-vba domdocument excel

我正在尝试使用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

它只是说许可被拒绝了。

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

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

1 个答案:

答案 0 :(得分: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

enter image description here

HTH
桑托什