excel VBA - extract URL from hyperlink with including # and after-CodePudding

The following code isn't extracting URLs past the "#"

The setup

URL1/2 in A1/2 then command/control k to set hyperlink

example

A1 = URL1 = http://stackoverflow.com/hello

A2 = URL2 = http://stackoverflow.com/hello#world

Using VBA code below

=URL(A1) = Result = http://stackoverflow.com/hello (DESIRED)

=URL(A2) = Result = http://stackoverflow.com/hello (NOT DESIRED)

Desired:

A2 = http://stackoverflow.com/hello#world

Question

Is there a way to modify the code below to include the entire URL even after #.

VBA code

Function URL(Hyperlink As Range)
  URL = Hyperlink.Hyperlinks(1).Address
End Function

CodePudding user response：

Try this:

Function URL(Hyperlink As Range) As String
  Dim sa As String
  If Hyperlink.Hyperlinks.Count = 0 Then Exit Function
  With Hyperlink.Hyperlinks(1)
    sa = .SubAddress  'anything after #
    URL = .Address & IIf(sa <> "", "#" & sa, "")
  End With
End Function

CodePudding user response：

Your function is accepting a range. If a range of more than one cell is used, with each cell containing a hyperlink. The hard coding of 1 will always only return the first hyperlink.

In the same way that you test for no hyperlinks, you may also want to test for more than one hyperlink.

Then decide what to return.

Here is code to return all the hyperlinks in a range.

Sub test()
Dim Example1 As String
Dim Example2 As String
Dim Example3 As String

Example1 = URL(ActiveWorkbook.ActiveSheet.Range("A1"))
Example2 = URL(ActiveWorkbook.ActiveSheet.Range("A2"))
Example3 = URL(ActiveWorkbook.ActiveSheet.Range("A1:A3"))

MsgBox "Example 1:" & vbCrLf & Example1 & vbCrLf & "Example 2:" & _
        vbCrLf & Example2 & vbCrLf & "Example 3:" & vbCrLf & Example3

End Sub


Function URL(hyperlink As Range) As String
'Returns all hyperlinks in a range as text

If hyperlink.Hyperlinks.Count = 0 Then Exit Function
    
    For a = 1 To hyperlink.Hyperlinks.Count
        If hyperlink.Hyperlinks(a).SubAddress <> "" Then
            URL = URL & hyperlink.Hyperlinks(a).Address & "#" & hyperlink.Hyperlinks(a).SubAddress & vbCrLf
        Else
            URL = URL & hyperlink.Hyperlinks(a).Address & vbCrLf
        End If
    Next a

End Function

CodePudding user response：

You can try this:

URL = Hyperlink.Hyperlinks(1).TextToDisplay