VBA错误70：权限在IE自动化期间被拒绝

我一直试图通过Excel 2010在VBA中创build一个快速子例程，以通过bit.ly自动放置一个URL列表，并将缩写链接复制回原来的链接。 但是我得到一个错误70：权限被拒绝的运行时错误。 我有一些课程，这大部分工作，但我不是很熟悉VBA，如果可能的话，可以使用一些帮助来debugging（这将是一个巨大的帮助）。 代码如下： 

Option Explicit Dim IE As Object Sub AutoAbbrev() Set IE = CreateObject("InternetExplorer.Application") Dim holdURL As String Dim row_number As Integer IE.Visible = True For row_number = 101 To 112 holdURL = "" If Range("b" & row_number).Value = "" Then GoTo Skip IE.navigate "http://www.bitly.com" 'load bit.ly Do While IE.readyState <> 4 DoEvents Loop IE.document.all("shorten_url").Value = Range("b" & row_number).Value IE.document.all("shorten_btn").Click Do While IE.document.all("shorten_url").Value = Range("b" & row_number).Value Or IE.document.all("shorten_url").Value = "" DoEvents Loop holdURL = IE.document.all("shorten_url").Value IE.document.all("shorten_url").Value = "" Range("b" & row_number).Value = holdURL Skip: Next row_number End Sub Private Sub Command1_Click() AutoAbbrev End Sub Private Sub Form_Unload(Cancel As Integer) Set IE = Nothing If TypeName(IE) <> "Nothing" Then Unload IE Set IE2 = Nothing If TypeName(IE2) <> "Nothing" Then Unload IE2 End Sub

程序运行一次或多次迭代后，大多数情况下会抛出这个错误： 

 Do While IE.document.all("shorten_url").Value = Range("b" & row_number).Value Or IE.document.all("shorten_url").Value = "" DoEvents Loop

如果有任何具体的build议可以帮助我在这个驼峰，我将不胜感激。 谢谢！

自动化Internet Explorer始终是最后的手段，速度很慢，依赖于页面的结构保持不变。 如果可用的话，select一个API总是比较好的，在这种情况下，可以提供一个用于打击链接的API，您只需要获取您的身份validation令牌并在下面input： 

 Public Function Shorten(url As String) As String Const token As String = "YOUR AUTHENTICATION TOKEN" Static oRequest As Object If oRequest Is Nothing Then Set oRequest = CreateObject("winhttp.winhttprequest.5.1") With oRequest .Open "GET", "https://api-ssl.bitly.com/v3/shorten?access_token=" & token & "&longUrl=" & url & "&format=xml", False .send If Left(Split(.responsetext, "txt>")(1), 2) = "OK" Then Shorten = Split(Split(.responsetext, "url>")(1), "<")(0) End With End Function

然后，您可以在工作表中使用上面的函数

Interesting Posts