Home » excel » vba – EXCEL – Open all links in a new tab

vba – EXCEL – Open all links in a new tab

Posted by: admin May 14, 2020 Leave a comment

Questions:

I have an excel-sheet which contains many links.
How do I open them all at once in a new tab with my default browser?

How to&Answers:

That’s pretty easy in VBA

Sub OpenAll()
    Dim H As Hyperlink

    For Each H In ActiveWorkbook.ActiveSheet.UsedRange.Hyperlinks
        H.Follow
    Next
End Sub

If there are invalid URLs you can stop the code from erroring like this:

Sub OpenAll()
    Dim H As Hyperlink

    For Each H In ActiveWorkbook.ActiveSheet.Hyperlinks
        On Error Resume Next
        H.Follow
        On Error GoTo 0
    Next
End Sub

Answer:

Like this? Included checking url is valid (basic check). The advantage here is you adapt to log information about the response from the URL.

Option Explicit

Sub TEST()

    Dim h As Hyperlink

    For Each h In ActiveSheet.Hyperlinks

       If UrlOK(h.Address) Then h.Follow

     Next h

End Sub



Public Function UrlOK(ByVal url As String) As Boolean

    Dim request As Object
    Dim respCode As Long

    On Error Resume Next
    Set request = CreateObject("WinHttp.WinHttpRequest.5.1")

    With request
      .Open "GET", url, False
      .Send
      respCode = .Status
    End With

    If respCode = 200 Then UrlOK = True

    On Error GoTo 0

End Function

Edit: Thanks to @Omegastripes for noting

1) If you use MSXML2.XMLHTTP over WinHttp.WinHttpRequest.5.1 you get a more reliable result

Benefits include (amongst others):

A) Simplified code to open a URL.

B) Separate sessions do not impact each other.

C) Protected Mode IE Support

D) Credential Cache

2) Use HEAD over GET, in the request, to reduce network traffic

With a HEAD request, a server will only return the headers of a resource, rather than the resource itself.

So you could use a revised, more efficient function, as follows:

Public Function UrlOK(ByVal url As String) As Boolean

    Dim request As Object
    Dim respCode As Long

    On Error Resume Next
    Set request = CreateObject("MSXML2.XMLHTTP")

    With request
      .Open "HEAD", url, False
      .Send
      respCode = .Status
    End With

    If respCode = 200 Then UrlOK = True

    On Error GoTo 0

End Function

Image of code in a standard module and where to place cursor to execute Test sub.

Code and cursor placement for execution with F5