在Excel中使用VBA打开超链接（运行时错误9）

Question

我正在尝试使用VBA使用以下代码从我的excel中打开超链接：

numRow = 1
Do While WorksheetFunction.IsText(Range("E" & numRow))
    ActiveSheet.Range("E" & numRow).Hyperlinks(1).Follow
    numRow = numRow + 1
Loop

但是，在代码中我遵循超链接的那一点上，我一直在遇到Runtime Error 9: Subscript out of range情况。

我对VBA宏制作非常陌生（就像以前从未做过的一样），因此将不胜感激。 （如果有更好的方法可以打开单个列中每个单元格的链接，我也很高兴了解到这一点）

编辑（添加更多信息）

该超链接已使用HYPERLINK Worksheet函数创建，并且该文本未显示链接URL。 工作表数据样本如下所示：

看起来像什么

案例 ------ 链接
案例1 -----总结
案例2 -----摘要
案例3 -----总结

但是，显示文本“摘要”的单元格包含一个公式

=HYPERLINK("whateverthebaseurlis/"&[@[Case]]&"/Summary", "Summary")

这是必须遵循的链接。 该链接有效，可以手动跟随。 但是我需要通过宏来做

谢谢

Answer 1

可能因为您有一些带有文本但没有链接的单元格而出现错误！

检查链接而不是单元格是否为文本：

numRow = 1
Do While ActiveSheet.Range("E" & numRow).Hyperlinks.Count > 0
    ActiveSheet.Range("E" & numRow).Hyperlinks(1).Follow
    numRow = numRow + 1
Loop

Answer 2

如果在尝试打开超链接时引发错误，请尝试使用explorer.exe明确打开它。

Shell "explorer.exe " & Range("E" & numRow).Text

Hyperlinks(1).Follow无效的原因是该单元格中没有常规的超链接，因此它将超出范围

numRow = 1
Do While WorksheetFunction.IsText(Range("E" & numRow))
    URL = Range("E" & numRow).Text
    Shell "C:\Program Files\Internet Explorer\iexplore.exe " & URL, vbNormalNoFocus
    numRow = numRow + 1
Loop

检查此帖子是否有类似问题： http : //www.mrexcel.com/forum/excel-questions/381291-activating-hyperlinks-via-visual-basic-applications.html

Answer 3

经过测试

假设条件

我将在此处介绍3种情况，如Excel文件所示。

1. =HYPERLINK("www."&"Google"&".Com","Google") 。 该超链接具有友好的名称
2. www.Google.com普通超链接
3. =HYPERLINK("www."&"Google"&".Com")此超链接没有友好名称

屏幕截图：

逻辑：

1. 检查它是哪种超链接。 如果名称不是一个友好名称，则代码非常简单
2. 如果超链接具有友好名称，则代码尝试执行的操作是从=HYPERLINK("www."&"Google"&".Com","Google")提取文本"www."&"Google"&".Com" =HYPERLINK("www."&"Google"&".Com","Google") ，然后将其作为公式存储在该单元格中
3. 一旦公式将上述文本转换为普通的超链接，即没有友好名称，则我们将使用ShellExecute打开它
4. 重置单元格的原始公式

码：

Private Declare Function ShellExecute _
Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hWnd As Long, ByVal Operation As String, _
ByVal Filename As String, Optional ByVal Parameters As String, _
Optional ByVal Directory As String, _
Optional ByVal WindowStyle As Long = vbMinimizedFocus _
) As Long

Sub Sample()
    Dim sFormula As String
    Dim sTmp1 As String, sTmp2 As String
    Dim i As Long
    Dim ws As Worksheet

    '~~> Set this to the relevant worksheet
    Set ws = ThisWorkbook.Sheets(1)

    i = 1

    With ActiveSheet
        Do While WorksheetFunction.IsText(.Range("E" & i))
            With .Range("E" & i)
                '~~> Store the cells formula in a variable for future use
                sFormula = .Formula

                '~~> Check if cell has a normal hyperlink like as shown in E2
                If .Hyperlinks.Count > 0 Then
                    .Hyperlinks(1).Follow
                '~~> Check if the cell has a hyperlink created using =HYPERLINK()
                ElseIf InStr(1, sFormula, "=HYPERLINK(") Then
                    '~~> Check if it has a friendly name
                    If InStr(1, sFormula, ",") Then
                        '
                        ' The idea here is to retrieve "www."&"Google"&".Com"
                        ' from =HYPERLINK("www."&"Google"&".Com","Google")
                        ' and then store it as a formula in that cell
                        '
                        sTmp1 = Split(sFormula, ",")(0)
                        sTmp2 = "=" & Split(sTmp1, "HYPERLINK(")(1)

                        .Formula = sTmp2

                        ShellExecute 0, "Open", .Text

                        '~~> Reset the formula
                        .Formula = sFormula
                    '~~> If it doesn't have a friendly name
                    Else
                        ShellExecute 0, "Open", .Text
                    End If
                End If
            End With
            i = i + 1
        Loop
    End With
End Sub

Answer 4

获取单元超链接的一种更干净的方法：

使用Range.Value(xlRangeValueXMLSpreadsheet) ，可以获取XML中的单元超链接。 因此，我们只需要解析XML。

'Add reference to Microsoft XML (MSXML#.DLL)
Function GetHyperlinks(ByVal Range As Range) As Collection
    Dim ret As New Collection, h As IXMLDOMAttribute
    Set GetHyperlinks = ret
    With New DOMDocument
        .async = False
        Call .LoadXML(Range.Value(xlRangeValueXMLSpreadsheet))
        For Each h In .SelectNodes("//@ss:HRef")
            ret.Add h.Value
        Next
    End With
End Function

因此，您可以在代码中使用此功能，如下所示：

numRow = 1
Do While WorksheetFunction.IsText(Range("E" & numRow))
    FollowHyperlink GetHyperlinks(ActiveSheet.Range("E" & numRow))
    numRow = numRow + 1
Loop

如果您不需要numRow ，则可以：

Dim h as String
For Each h In GetHyperlinks(ActiveSheet.Range("E:E"))
    FollowHyperlink h
Next

对于FollowHyperlink ，我建议使用以下代码-您可以从其他答案中选择其他选项：

Sub FollowHyperlink(ByVal URL As String)
    Shell Shell "CMD.EXE /C START """" """ & URL & """"
End Sub