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

  • Z时代
  • 2024-01-10
  • 分类：问答

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

回答：

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

以上是 在新标签页中打开多个链接的宏 的全部内容， 来源链接： utcz.com/qa/265797.html

回到顶部