EXCEL-在新标签页中打开所有链接 [英] EXCEL - Open all links in a new tab

问题描述

我有一个包含许多链接的excel工作表.
如何使用默认浏览器在新标签页中一次全部打开它们?

解决方案

喜欢吗?包含的检查网址有效(基本检查).这样做的好处是您可以适应有关URL响应的日志信息.

 选项显式子TEST()昏暗作为超链接对于ActiveSheet.Hyperlinks中的每个h如果UrlOK(h.Address)然后h.Follow下一个小时结束子公共函数UrlOK(ByVal url为字符串)为布尔值暗淡要求作为对象暗淡的respCode一样长关于错误继续设置请求= CreateObject("WinHttp.WinHttpRequest.5.1")有要求.Open"GET"，网址，False.发送respCode = .Status结束于如果respCode = 200，则UrlOK = True出错时转到0结束功能 

编辑:感谢@Omegastripes的注意

1)(如果您使用

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?

解决方案

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.

这篇关于EXCEL-在新标签页中打开所有链接的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！