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

Open Hyperlinks Using VBA in Excel (Runtime Error 9)

提问by Shisa

I am trying to use VBA to open hyperlinks from my excel using the following code:

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

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

However, I keep getting Runtime Error 9: Subscript out of rangeat the point in the code where I follow the hyperlinks.

但是，我一直Runtime Error 9: Subscript out of range在代码中遵循超链接的地方。

I'm pretty new to VBA Macro-making (as in-'never done it before'), so help would be appreciated. (And if there's a better way to open a link from each cell in a single column, I'd appreciate learning about that too)

我对 VBA 宏制作还很陌生（因为“以前从未做过”），因此将不胜感激。（如果有更好的方法可以打开单个列中每个单元格的链接，我也很乐意了解这一点）

EDIT (To add more Info)

编辑（添加更多信息）

The hyperlink in question has been created using HYPERLINK Worksheet function and the text does not display the link URL. Sample of worksheet data is something like this:

有问题的超链接是使用 HYPERLINK 工作表功能创建的，文本不显示链接 URL。工作表数据示例如下：

What It Looks Like

它看起来像什么

Case------ Link
Case1----- Summary
Case2----- Summary
Case3----- Summary

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

The Cells showing the text "Summary", however, contain a formula

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

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

And this is the link that has to be followed. The link works, it can be followed manually. But I need to do it via macro

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

Thanks

谢谢

回答by LS_???

Probably, you are getting error because you have some cells with text but no link!

可能，您收到错误是因为您有一些带有文本但没有链接的单元格！

Check for link instead of whether or not cell is text:

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

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

回答by manimatters

If it is throwing the error where you try to open hyperlinks, try and explictly open it using explorer.exe

如果它在您尝试打开超链接的地方抛出错误，请尝试使用 explorer.exe 显式打开它

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

the reason Hyperlinks(1).Follownot working is that is no conventional hyperlink in the cell so it will return out of range

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

Check this post for a similar problem: http://www.mrexcel.com/forum/excel-questions/381291-activating-hyperlinks-via-visual-basic-applications.html

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

回答by Siddharth Rout

TRIED AND TESTED

久经考验

Assumptions

假设

I am covering 3 scenarios here as shown in the Excel file.

我在这里涵盖了 3 个场景，如 Excel 文件中所示。

1. =HYPERLINK("www."&"Google"&".Com","Google"). This hyperlink has a friendly name
2. www.Google.comNormal hyperlink
3. =HYPERLINK("www."&"Google"&".Com")This hyperlink doesn't have a friendly name

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

Screenshot:

截屏：

Logic:

逻辑：

1. Check what kind of hyperlink is it. If it is other than which has a friendly name then the code is pretty straightforward
2. If the hyperlink has a friendly name then what the code tries to do is extract the text "www."&"Google"&".Com"from =HYPERLINK("www."&"Google"&".Com","Google")and then store it as a formula in that cell
3. Once the formula converts the above text to a normal hyperlink i.e without the friendly name then we open it using ShellExecute
4. Reset the cell's original formula

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

Code:

代码：

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

回答by LS_???

A cleaner way of getting cells hyperlinks:

一种更简洁的获取单元格超链接的方法：

Using Range.Value(xlRangeValueXMLSpreadsheet), one can get cell hyperlink in XML. As so, we only have to parse XML.

使用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

So you can use this function in your code as this:

所以你可以在你的代码中使用这个函数：

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

If you don't need numRow, you can just:

如果你不需要numRow，你可以：

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

For FollowHyperlink, I suggest below code - you have other options from another answers:

对于FollowHyperlink，我建议使用以下代码 - 您还有其他答案的其他选项：

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