打開超鏈接在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

如果是扔在那裏你嘗試打開超鏈接錯誤，請嘗試和顯式使用的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 2

可能做到這一點，你得到錯誤，因爲你有一些細胞與文字，但沒有聯繫！

檢查鏈接，而不是是否細胞是文本：

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

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"，然後將其作爲公式存儲在該單元格中
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