我希望我的宏在单独的IE选项卡中打开存储在电子表格中的每个链接。我成功打开了第一个链接,但出于某种原因在循环的第二次迭代中我得到:
自动化错误。界面未知错误。
我怀疑宏在第一次迭代后以某种方式失去了IE对象引用,但我不确定为什么。
范围设置正常。
这是代码:
Sub OpenCodingForms()
Dim wb1 As Workbook
Dim ws1 As Worksheet
Dim CodingFormLinks As Range
Dim IE as InternetExplorerMedium
Set wb1 = Workbooks("New shortcut.xlsm")
Set ws1 = wb1.Worksheets("Data")
Set CodingFormLinks = ws1.Range("A2", Range("A2").End(xlDown))
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
ws1.Activate
For Each link In CodingFormLinks.Cells
IE.Navigate link, CLng(2049)
Next link
End Sub
我之前遇到过这个问题并最终只是编写一个例程来获取实例。您需要添加对shell控件和自动化的引用。
如果有重定向,您可能必须调整此值以在实际URL的开头查找sURL var。
Sub OpenCodingForms()
Dim wb1 As Workbook
Dim ws1 As Worksheet
Dim CodingFormLinks As Range
Dim IE As InternetExplorerMedium
Set wb1 = Workbooks("New shortcut.xlsm")
Set ws1 = wb1.Worksheets("Data")
Set CodingFormLinks = ws1.Range("A2", Range("A2").End(xlDown))
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
ws1.Activate
Dim sUrl As String
For Each link In CodingFormLinks.Cells
sUrl = link.Value
IE.navigate sUrl, CLng(2048)
Set IE = GetWebPage(sUrl)
Next link
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Desc: The Function gets the Internet Explorer window that has the current
' URL from the sURL Parameter. The Function Timesout after 30 seconds
'Input parameters:
'String sURL - The URL to look for
'Output parameters:
'InternetExplorer ie - the Internet Explorer window holding the webpage
'Result: returns the Internet Explorer window holding the webpage
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetWebPage(sUrl As String) As InternetExplorer
Dim winShell As Shell
Dim dt As Date
'set the timeout period
dt = DateAdd("s", 300, DateTime.Now)
Dim IE As InternetExplorer
'loop until we timeout
Do While dt > DateTime.Now
Set winShell = New Shell
'loop through the windows and check the internet explorer windows
For Each IE In winShell.Windows
'check for the url
If IE.LocationURL = sUrl Then
'set the window visible
IE.Visible = True
IE.Silent = True
'set the return value
Set GetWebPage = IE
Do While IE.Busy
DoEvents
Loop
Set winShell = Nothing
Exit Do
End If
Next IE
Set winShell = Nothing
DoEvents
Loop
End Function