Macro to open multiple links in new tabs - vba

Question

I want my macro to open each link stored in a spreadsheet in a separate IE tab. I am successful with opening the first link, but for some reason on the second iteration of the loop I get:
Automation error.The interface is unknown
error.
I suspect the macro somehow loses IE object reference after first iteration, but I am not sure why.
Range is set OK.
Here is the code:
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

I ran into this issue before and ended up just writing a routine to get the instance. You will need to add a reference to shell controls and automation.
you may have to adjust this to look for the sURL var in the beginning of the actual URL if there is redirection.
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