EXCEL - 打开新标签中的所有链接

Question

我有一张包含许多链接的excel表 如何使用我的默认浏览器在新选项卡中一次打​​开它们？

Answer 1

在VBA中这很容易

Sub OpenAll()
    Dim H As Hyperlink

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

如果网址无效，您可以停止代码错误，如下所示：

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 2

喜欢这个？包含的检查网址有效（基本检查）。这里的优点是您可以适应有关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

修改：感谢@Omegastripes注意

1）如果您使用MSXML2.XMLHTTP over WinHttp.WinHttpRequest.5.1，您将获得更可靠的结果

好处包括（其中包括）：

A）打开网址的简化代码。

B）单独的会话不会相互影响。

C）保护模式IE支持

D）凭证缓存

2）在请求中使用HEAD而不是GET来减少网络流量

对于HEAD请求，服务器将仅返回资源的标头，而不是资源本身。

因此，您可以使用修订的，更有效的功能，如下所示：

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

标准模块中的代码图像以及放置光标以执行Test sub的位置。