在新标签页中打开多个链接的宏

我希望我的宏在单独的IE选项卡中打开存储在电子表格中的每个链接。我是成功的，打开第一个链接，但在循环的第二次迭代某种原因，我得到：在新标签页中打开多个链接的宏

自动化和error.The接口是未知错误。

我怀疑宏在第一次迭代后失去IE对象引用，但我不知道为什么。

范围设置OK。

下面是代码：

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

来源

2017-12-27 barciewicz

我得到多个窗口打开，如果我定义链接的范围，并导航到Link.Text，如果我用2048我可以让他们在现有窗口的新选项卡中打开。 – QHarr

尝试CLng（2048）而不是CLng（2049），您也可以尝试在循环中尝试延迟以允许页面加载 - 而IE.Busy |做事件| Wend – Absinthe

我尝试了所有的建议，但无济于事，仍然是同样的错误。但是，如果我在循环内移动“设置IE”和“IE.Visible”，我设法打开新窗口中的所有链接，但这不是首选解决方案。 – barciewicz

我就遇到了这个问题之前，最终只是写一个程序来获得实例。您将需要添加对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

来源

2017-12-27 21:52:45 Sorceri

在新标签页中打开多个链接的宏

回答

相关问题