Question

我希望我的宏能够在单独的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

Answer 1

之前我遇到过这个问题，最后只是编写一个例程来获取实例。您需要添加对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

宏以在新选项卡中打开多个链接

1 个答案: